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FOREWORD 


The  computer  program  reported  herein  was  prepared  by  The  Boeing 
Company  for  the  Aero -Acoustics  Branch,  Vehicle  Dynamics  Division,  Air 
Force  Flight  Dynamics  Laboratory,  Wright-Patterson  Air  Force  Base,  Ohio, 
under  contract  AF  33(615)-5155.  The  study  demonstrates  the  application 
of  finite-element  matrix  methods  in  determining  the  responses  and 
fatigue  life  of  complex  panels  excited  by  random  pressure  fluctuations. 
The  program  is  part  of  a  continuing  effort  to  establish  tolerance 
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modifications  to  the  matrix  manipulation  module. 
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ABSTRACT 


A  programming  description  is  presented  for  a  computer  program 
developed  to  aid  in  the  design  of  sonic-fatigue-resistant  aircraft  structures. 
The  computer  program  is  written  in  FORTRAN  IV  and  MAP  for  the  IBM  7094 
Mod  II.  The  program  employs  matrix  structural  analysis  methods  to  calcu¬ 
late  statistical  measurements  of  response  (deflection  and  stress)  for  complex 
structure  subjected  to  pressure  loads  random  in  both  time  and  space.  The 
program  is  organized  into  two  phases,  each  performed  separately.  The 
phases  are  further  organized  in  modular  form  for  ease  of  maintenance  and/or 
modification. 
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INTRODUCTION 


RANVIB  is  a  computer  program  developed  to  aid  in  sonic  fatigue  analysis . 
The  program  employs  matrix  methods  to  calculate  statistical  measurements  of 
response  (deflection  and  stress)  for  complex  structure  subjected  to  random 
sound  fields.  The  RANVIB  system  is  written  in  FORTRAN  IV  and  MAP  languages 
for  use  on  an  IBM  7094  Mod  II  under  the  IBSYS  Version  13  operating  system. 

The  computer  program  report  is  in  two  Parts: 

(1)  Parti — Engineering  User's  Guide 

(2)  Part  II — Computer  Program  Description 

Part  I  is  a  guide  for  an  engineer's  use  of  RANVIB.  Part  II  describes 
the  RANVIB  computer  program  and  is  intended  primarily  for  the  programmer/ 
analyst  responsible  for  the  implementation  and  subsequent  maintenance  of  the 
system. 

Development  of  the  theory  of  this  program  and  its  application  to  specific 
problems  are  presented  in  document  AFFDL-TR-68-44,  reference  1.  An 
earlier  study  that  uses  portions  of  this  program  is  reported  in  document 
AFFDL-TR-67-81,  reference  2. 

This  volume  is  divided  into  four  sections.  Section  II  describes  the  logical 
and  system-oriented  organization  of  the  RANVIB  program.  Sections  III  and  IV 
describe  the  programming  details  of  the  FORTRAN  modules  of  the  system. 
Section  m  is  a  description  of  the  modules  in  the  phase  I  structural  and  vibra¬ 
tion  programs.  Section  IV  describes  phase  II  programs:  the  random  loading 
module  and  the  random  response  solution  modules.  Appendixes  I  and  n  con¬ 
tain  descriptions  and  listings  of  the  matrix  manipulative  scheme  TL01  used 
throughout  RANVIB,  and  general-purpose  subroutines.  Appendixes  HI  and  IV 
contain  the  listings  of  phase  I  and  II  programs,  respectively. 


1 


II 


GENERAL  PROGRAM  DESCRIPTION 
1.  PROGRAM  ORGANIZATION 

The  RANVIB  system  is  divided  into  phases  I  and  II.  Phase  I  (figure  1)  is 
an  integrated  set  of  computer  programs  for  determining  the  static  and  dynamic 
characteristics  of  the  structure.  Phase  II  (figure  2)  uses  results  of  phase  I 
and  determines  sonic  loads  and  random  structural  response.  This  division 
permits  the  analysts  to  assess  the  results  of  phase  I  before  proceeding  to 
phase  II.  The  matrix  interpretive  scheme  TL01  written  in  MAP  is  used  to 
perform  matrix  operations  in  both  phases. 

a.  Phase  I — Structural  and  Vibration  Programs 

There  are  two  major  modules  in  phase  I. 

The  first  one  MAST  (matrix  structural  generator)  generates  and  merges 
element  stiffness  and  stress  matrices  and  reduces  unwanted  freedoms  to  form 
the  reduced  structural  stiffness,  flexibility,  and  stress-deflection  matrices. 
These  matrices  are  then  merged  and  stored  on  tape  for  later  use  by  the 
FREMOD  routine  and  phase  II  programs. 

The  second  module  FREMOD  (frequencies  and  modes  generator)  generates 
natural  frequencies,  normal  modes,  and  generalized  masses  using  the  flexibility 
matrix  (MAST  output  tape)  and  mass  matrix  (card  input). 

An  optional  path  in  phase  I  executes  only  the  FREMOD  module  using  a 
previously  calculated  flexibility  matrix.  This  option  is  a  convenient  feature 
when  an  analyst  wants  to  change  mass  distribution  and/or  change  the  number 
of  modes.  A  new  diagonal-mass  matrix  is  required;  input  is  on  cards. 

b.  Phase  II — Random  Load  and  Response  Programs 

This  section  generates  the  excitation  cross-power  spectral  density  (cross 
PSD)  and  the  response  solution  options  (deflection  and  stress  cross  PSD)  and 
statistical  moments . 

The  random  pressure  loads  (excitations)  are  stored  on  an  intermediate  out¬ 
put  tape  used  in  the  response  programs.  The  results  from  phase  I  output  tape 
are  also  used  in  phase  II. 
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Figure  1.  Phase  I  Organization 
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OPTIONS  1, 2,  OR  3? 

DEFLECTION  CROSS- 
PSD  SOLUTION 

PROGRAMS 
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MEAN-SQUARE  RESPONSE 
SOLUTION  PROGRAMS 
(STRESS  &  DEFLECTION) 

' 

STRESS  &  DEFLECTION  SECOND- 
SPECTRAL-MOMENT  PROGRAMS 

' 

(  END  ) 


Figure  2.  Phase  II  Organization 
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The  response  solution  modules  are  divided  into  three  options: 

(1)  Option  1 — General  viscous  damping 

(2)  Option  2 — Normal  modes 

(3)  Option  3 — Normal  modes  without  cross  terms 

Reference  3  describes  the  options  in  more  detail. 

Cross  PSD  and  joint  moments  are  formed  for  each  option.  It  is  also 
possible  to  generate  the  stress  second  spectral  moments  used  in  predicting 
fatigue  life. 

2.  SYSTEM  ORGANIZATION 

a.  Phase  I  and  II  Overlay  Structures 

The  overlay  structure  on  a  subroutine  basis  is  illustrated  in  figure  3.  The 
detailed  overlay  structure  for  MAST  and  FREMOD  are  shown  in  figures  17  and 
32,  respectively  (pages  36  and  67). 

b.  Core  and  Tape  Requirements 

The  RANVIB  program  requires  a  32K  core  when  operating  on  the  IBM 
7094  Mod  II  computer  under  the  IBSYS  Version  13  system. 

Tape  requirements  in  phase  I  and  phase  II  are  shown  in  table  I.  Core  maps 
of  phases  I  and  II  are  shown  in  tables  II  and  III,  respectively. 

c.  Deck  and  Master  Tape  Setups 
(1)  Operating  Procedure 

The  following  is  the  procedure  a  system  analyst  should  follow  in  initiating 
phase  I  and  phase  II  operations  for  the  direct-coupled  system  (DCS). 

The  nine  files  on  the  phase  I  master  tape  are  generated  by  the  card-to-tape 
process.  The  first  file  contains  binary  decks,  and  the  remaining  eight  files 
contain  TL01  data  decks  (figure  4).  Use  the  appropriate  control  cards  for  the 
DCS  for  phases  I  and  II.  Mount  the  phase  I  master  tape  on  logical  unit  9.  The 
output  tape  from  phase  I  will  contain  four  files  on  logical  unit  10. 
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Figure  3.  Phase  I  and  II  Overlay  Structures 


Table  I.  Tape  Use 


Logical  unit 

Function 

PHASE  I* 

2 

The  parameter  matrix  and  stiffness  matrix  are 
stored  on  this  tape  (output  from  MAST).  This  tape 
is  also  used  as  a  scratch  unit. 

3 

Scratch 

4 

Scratch 

5 

Standard  system  input  tape 

6 

Standard  system  output  tape 

8 

Stress  matrices  for  plates  from  MAST 

9 

Program  master  tape 

10 

Phase  I  output  tape 

12 

Stress  matrices  for  beams  from  MAST 

PHASE  IP* 

9 

Program  master  tape 

10 

Input  tape  from  phase  I 

1-4,  7-8,  11-17 

Intermediate  scratch  tapes 

5 

Standard  system  input  tape 

6 

Standard  system  output  tape 

*See  figure  19  for  tape  use  of  logical  units  1  through  16  for  the  MAST 
routine  (page  43) . 

**Figure  43,  page  84,  illustrates  the  tape  use  in  the  phase  II  program. 

The  phase  II  master  tape  consists  of  seven  files  and  is  again  generated  by 
the  card-to-tape  process.  The  first  file  contains  binary  decks,  and  the 
remaining  six  files  contain  TL01  data  decks  (figure  5).  In  this  operation,  mount 
the  phase  II  master  tape  on  logical  unit  9. 

The  master  tapes  for  phases  I  and  n  are  assigned  to  system  unit 
SYSLB4  (logical  unit  9).  The  system  overlay  is  assigned  to  system  unit  SYSCK2. 
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(LOGICAL  UNIT  9) 


ABSOLUTE  BINARY 
DECKS  OF  PHASE  I 
(1  FILE) 

(SEE  REF.  3  FOR  A  LISTING  OF  THE  SUBROUTINES.; 


TLOI  DATA  FOR  MAST 

_ PROGRAM  (8  FILES) 

(SEE  FIG.  20  FOR  FILE  DESCRIPTIONS.) 


Figure  4.  Phase  I  Master  Tape 


*END  FILE 


LOGICAL  UNIT  9 


ABSOLUTE  BINARY 
DECK  OF  PHASE  II 
(SEE  REF. 3) 

TLOI 

OPTION  3. 
DJNT3 
SJNT3 
DSJNT3 

TLOI 

OPTION  3, 
CPSD3 
SRESP3 

TLOI  [ 

OPTION  2, 
DJNT3 
DJNT2 
SJNT2 
DSECM3 
DSECM2 
SJNT2 

TLOI 

OPTION  2, 
CPSD3 
CPSD2 
SRESP2 

TLOI 

OPTION  1, 
COMINV 
CPSD1 
SRESP1 

TLOI 

OPTION  1, 
TRAPM 
SJNT1 
SSECM1 

FILE  1 

FILE  2 

FILE  3 

FILE  4 

FILE  5 

FILE  6 

FILE  7 


Figure  5.  Phase  II  Master  Tape 
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(2)  Input/Output  Editor 

The  input /output  editor  ($IEDIT)  is  used  for  two  functions:  (1)  to  read 
information  off  the  master  tape,  and  (2)  to  assist  the  programmer  in  modifying 
existing  subroutines. 

When  used  to  read  information  off  the  master  tape,  the  $IEDIT  card 
precedes  the  component  control  card  of  the  deck  that  is  affected.  The  specifi¬ 
cations  on  the  control  card  remain  in  effect  until  the  end  of  the  application  or 
until  another  $IEDIT  card  changes  the  specifications .  The  format  of  the 
$IEDIT  card  with  optional  instructions  starting  in  column  16  for  the  RANVIB 
system  is: 

2  4  6 _  _  _  16  JB  2Q  212  24  ,26  _  _  _  » 

Column:  13  5  - in .  i  i|»  2a  23  »  

$IEDIT - SYS  LB  4,  SRCH  — - 

The  following  procedure  should  be  followed  when  an  analyst/programmer 
wants  to  change  any  source  or  binary  subroutines . 

(a)  Pull  the  appropriate  $IBLDR  card  out  of  the  phase  I  /phase  II  control  deck. 

(b)  Insert  a  $IEDIT  card  with  no  optional  instructions  (columns  16  and  on 
are  blank) . 

(c)  Insert  the  modified  subroutine  source  or  binary  deck. 

Insert  a  $IEDIT  card  with  optional  instructions  SYSLB4,  SRCH  (see 

the  example  above). 

[Col  1  Col  16 

$IEDIT  SYSLB4,SRCHj 


19 


Ill 


PHASE  I — STRUCTURAL  AND  VIBRATION  PROGRAMS 

Phase  I  is  an  integrated  set  of  computer  programs  for  determining  the  static 
and  dynamic  characteristics  of  the  structure.  The  execution  of  this  phase  is 
controlled  by  the  PHASE  1  subroutine.  The  MAST  module,  FREMOD  module, 
and  intermediate  matrix  merge  programs  are  called  from  the  control  program. 
The  program  listings  for  phase  I  are  included  in  appendix  ID. 

1.  MATRIX  STRUCTURAL  GENERATOR  PROGRAM  (MAST) 

a.  General  Description 

The  purpose  of  the  MAST  module  is  to  generate  and  merge  element  stiffness 
and  stress  matrices  and  to  reduce  out  unwanted  freedoms. 

The  input  is  in  card  form  and  describes  the  physical  structure  in  terms  of 
nodes  connected  by  beams  and  plates.  Other  inputs  are  boundary  conditions  that 
fix  the  structure  in  space  and  retained -freedom  information  that  specifies  the 
freedoms  to  be  retained  in  the  final  matrices.  The  output  is  via  tape  to  the 
other  modules  and  includes  the  reduced  stiffness  matrix,  flexibility  matrix,  and 
stress  matrices  for  both  beams  and  plates. 

The  module  is  divided  into  four  segments.  The  first  segment  (generation) 
generates  elemental  stiffness  and  stress  matrices  for  beam  and  plate  elements. 
The  second  segment  (merge)  merges  these  elemental  matrices  to  form  the  struc¬ 
tural  stiffness  and  stress  matrices  and  deletes  the  constrained  freedoms  from 
the  stiffness  matrix.  The  third  segment  (sorting)  sorts  the  stiffness  and  stress 
matrices  into  retained  and  reduced  partitions.  The  final  segment  (reduction) 
then  performs  the  actual  equation  solving  necessary  for  reduction. 

The  module  is  restricted  to  a  maximum  of  2, 000  nodes  and  7,  000  retained 
freedoms.  The  number  of  beam  and  plate  elements  is  unrestricted.  These 
limits  are  set  by  core  storage  limitations,  and  any  attempt  to  run  problems  in 
this  size  range  may  be  restricted  by  machine  reliability  and  the  peripheral 
storage  size  of  the  computer  being  used. 


21 


b.  Major  Program  Functions 

(1)  Elemental -Matrix  Generation 

(a)  Beam  Matrices 

The  elemental  matrices  for  beams  are  generated  one  at  a  time  in  the  order 
that  the  input  data  are  read.  This  generation  includes  the  various  transformation 
matrices  and  the  stiffness  matrix  in  local  coordinates.  The  first  transformation 
matrix  generated  (if  offsets  are  present)  is  the  offset  transformation  from  the 
beam's  neutral  axis  location  to  node  point  location.  Next,  the  stress- 
transformation  matrix  and  local-stiffness  matrix  are  generated.  The  offset 
transformation  is  then  applied  to  the  stress  transformation  and  this  premulti¬ 
plies  the  local-stiffness  matrix  to  obtain  the  beam-stress  matrix.  This  beam- 
stress  matrix  is  finally  premultiplied  by  the  transpose  of  the  combined  offset 
and  stress-transformation  matrix  to  obtain  the  stiffness  matrix  in  structural 
coordinates. 

These  matrices  are  then  written  on  tape  for  later  use  by  the  merge  segment. 
The  structure  of  these  elemental  matrices  is  as  shown  in  figures  6  and  7. 

Each  beam  is  also  checked  to  determine  which  partitions  of  the  merged 
stiffness  matrix  it  will  contribute  to.  A  list  of  partitions  is  created  that  con¬ 
tains  partition  identification  numbers  for  the  partitions  having  non-null  elements. 
This  list  is  updated  when  elements  are  found  that  will  contribute  to  partitions 
not  already  in  the  list. 

(b)  Plate  Matrices 

The  plate-element  matrices  are  also  generated  one  plate  at  a  time  in  the 
order  that  the  input  data  are  read.  The  elemental  stiffness  matrix  in  local 
coordinates  is  first  generated  and  then  the  coordinate  and  stress-transformation 
matrices  are  generated.  In  generating  the  stiffness  for  quadrilateral  plates, 
the  program  subdivides  the  quadrilateral  into  four  triangles  (figure  8)  with  a 
fifth  "dummy"  node  placed  at  the  centroid.  The  four  triangles  are  then  merged 
to  form  the  local -stiffness  matrix  for  the  quadrilateral  plate,  and  the  terms  for 
the  fifth  node  are  reduced  out.  Next,  the  local-stiffness  matrix  is  post  multiplied 
by  the  transpose  of  the  coordinate-transformation  matrix  and  this  result  is  saved. 
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✓ 


END  1 


END  2 
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s  / 
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END  1  < 


END  2  - 


Figure  6.  Elemental  Beam  Stiffness  Matrix  Layout 
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END  1 


END  2 


END  1 


END  2 
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Figure  7.  Elemental  Beam  Stress  Matrix  Layout 
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NOTE:  NODE  5  IS  AT  CENTROID  OF  PLATE. 

Figure  8.  Quadrilateral  Plate  Layout 


This  intermediate  result  is  then  premultiplied  by  the  stress-transformation 
matrix  producing  the  elemental  stress  matrix  (figure  9)  that  is  saved  on  tape. 

The  coordinate  transformation  of  the  stiffness  matrix  is  then  completed  by  pre¬ 
multiplying  the  product  of  the  local-stiffness  matrix  and  the  transpose  of  the 
coordinate-transformation  matrix  by  the  coordinate-transformation  matrix, 
resulting  in  an  elemental  stiffness  matrix  in  structural  coordinates  (figure  10). 
This  result  is  then  saved  on  tape.  As  with  the  beams,  each  plate  is  checked 
to  see  which  partitions  of  the  merged  matrix  it  will  contribute  to,  and  the  con¬ 
nectivity  data  are  updated  accordingly. 

(2)  Structural  Matrix  Formation 

(a)  Matrix  Partitioning  and  Identification 

The  structural  stiffness  and  stress  matrices  are  handled  in  partitioned  form. 
The  maximum  size  of  these  partitions  is  determined  by  the  core  storage  limita¬ 
tions  of  the  computer.  The  partition  size  for  the  stiffness  matrix  is  60  by  60, 
and  the  partition  size  of  the  stress  matrix  is  96  by  60.  Each  stiffness -matrix 
partition  corresponds  to  ten  nodes  with  six  freedoms  per  node  (figure  11),  unless 
the  option  for  specifying  smaller  partition  sizes  is  used.  The  beam-stress 
matrix  partitions  contain  ten  nodes  with  six  freedoms  per  node  in  the  column 
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NODE!  NODE  2  NODE  3  NODE  4 


NOTE:  NODE  4  TERMS  ARE  OMITTED  FOR  TRIANGULAR  PLATE 


Figure  9.  Elemental  Plate  Stress  Matrix  Layout 

direction  and  eight  beams  with  twelve  stresses  per  beam  in  the  row  direction 
(figure  12).  The  plate-stress  matrix  partitions  contain  ten  nodes  in  the  column 
direction  and  twelve  plates  with  eight  stresses  per  plate  in  the  row  direction. 

Each  matrix  partition  is  given  a  partition  identification  number  that  indicates 
its  location  in  the  overall  matrix.  The  number  consists  of  two  parts:  the  row 
position  and  the  column  position  (figures  11  and  12).  Therefore,  partition  1001 
is  the  first  partition  in  row  1,  1002  is  the  second  partition  of  row  1,  and  2001 
is  the  first  partition  in  row  2.  Both  stiffness  and  stress  partitions  are  identified 
in  this  manner. 

(b)  Matrix  Merge  Procedure 

The  stiffness  matrix  is  merged  by  partition  with  three  partitions  being 
merged  simultaneously.  The  connectivity  data  created  in  the  generation  phase 
contain  a  list  of  the  non-null  partitions;  the  merge  procedure  is  controlled  by 
this  array.  The  merge  segment  first  sorts  this  array  into  ascending  order  of 
partition  identification  number  and  then  begins  merge  by  taking  the  first  three 
identification  numbers  and  merging  all  of  the  beam  and  plate  elements  that 
contribute  to  these  three  partitions. 
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NODE  1 


NODE  2 
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NODE  1 
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NODE  2 
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NODE  3 


NODE  4 
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NOTE:  ROWS  AND  COLUMNS  FOR  NODE  4  ARE  OMITTED  FOR  TRIANGULAR 
PLATES  YIELDING  AN  (18  x  18)  STIFFNESS  MATRIX. 


Figure  10.  Elemental  Plate  Stiffness  Matrix  Layout 
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NODES  1-10 

NODES  11-20 

NODES  21-30' 

NODES  31-36 

r'" 

NODES  1-10  j 

' 

1001 

NODES  1 1-20  j 

2001 

2002 

r 

NODES  21-30 < 

3001 

300? 

3003 

NODES  31-36  1 

r 

4001 

4002 

4003 

4004 

Figure  11.  Structural  Matrix  Partitioning 


NODES  1-10  NODES  11-20  NODES  21-30  NODES  31-36 


Figure  12.  Merged  Stress  Matrix 


After  the  merging  of  each  group  of  three  stiffness  matrix  partitions,  the 
three  partitions  are  sorted  by  applying  the  constraint  conditions  specified  in 
the  input  data.  The  elements  relating  the  unrestrained  freedoms  are  sorted  into 
the  upper  left-hand  comer  of  each  partition,  whereas  the  constrained  freedoms 
are  sorted  into  the  lower  right-hand  corner  of  the  partition.  The  upper  right- 
hand  and  lower  left-hand  portions  of  the  partition  contain  the  crosscoupling 
terms  between  the  two  types  of  freedoms  (figure  13). 

Only  the  upper  left-hand  portion  (hereafter  referred  to  as  [Kff]  for 
K-free-free)  is  saved  on  tape  for  later  use.  The  other  parts  are  discarded. 

The  program  merges  only  the  non -null  partitions.  The  matrix  is  in  lower 
triangular  form  since  it  is  symmetrical  about  the  diagonal. 

The  stress  matrices  are  merged  in  much  the  same  way  as  the  stiffness 
matrices  with  the  main  difference  being  that  the  stress  terms  do  not  add  to 
each  other  as  they  do  in  the  stiffness  matrix.  Again,  only  the  non-null  parti¬ 
tions  are  formed.  The  beam  and  plate  stresses  are  merged  separately,  resulting 
in  two  structural  stress  matrices:  one  for  beams  and  one  for  plates. 

(3)  Matrix  Sorting  and  Expansion 

To  reduce  unwanted  freedoms,  the  [K^J  matrix  must  be  sorted  into  four 
parts.  The  [K^]  part  relates  freedoms  that  are  to  be  retained.  The  [K22) 
part  relates  freedoms  that  are  to  be  reduced.  The  [Kj^]  and  [K2jJ  parts 
contain  the  terms  of  crosscoupling  between  the  two  types  of  freedoms.  Also, 
since  the  TL01  reduction  phase  requires  matrices  in  full  form  rather  than  in 
lower  triangular,  the  four  parts  (Kill  ,  [K12l  *  *  and  1^2^ 

must  be  expanded  from  lower  triangular  to  full  form. 

The  stress  matrix  must  be  sorted  into  two  parts  in  the  column  direction 
with  only  the  first  part  [S^  corresponding  to  the  [K-^l  freedoms  and  with 
the  second  part  f S2 )  corresponding  to  the  [K22]  freedoms  (figure  14). 

The  sorting  of  the  [Kjf]  partitions  is  done  one  partition  at  a  time,  and  the 
four  parts  are  written  on  separate  tapes.  Since  [K^]  does  not  contain  null 
partitions,  these  must  also  be  supplied  at  this  time  with  the  result  being  the 
four  parts  [Kn]  ,  [K12]  ,  [K21)  ,  and  (K22)  on  tapes  in  lower  tri¬ 

angular  form  with  null  partitions  inserted.  The  expansion  process  takes  place 
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NOTE:  [Kfc]  ,  [Kcf]  ,  AND  [Kcc]  TERMS  ARE  DELETED  AND  ONLY  [Kff]  IS. 
WRITTEN  ON  TAPE. 


(a)  Merged 


N 


(b)  Sorted 
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Figure  13.  Stiffness  Matrix  Partitions 


NUMBER 

OF 

ELEMENTS 
IN  THE  GIVEN  . 
ROW  OF 
PARTITIONS 


Figure  14.  Sorted  Stress  Matrix  Partition 


next  with  [Kn]  and  [K22]  being  expanded  by  the  same  subroutine  (EXPAND). 
The  expansion  of  [K12]  and  f K21]  ,  however,  is  complicated  by  the  fact  that 

a  given  partition  in  [K^]  need  not  have  any  retained  freedoms.  This  results 
in  [K21]  and  [K12]  matrices  that  are  not  exactly  lower  triangular  in  form 
(figure  15).  Therefore,  a  separate  subroutine  is  required  to  perform  the  expan¬ 
sion  of  these  two  matrices  (EXTRAN)  with  (K21)  being  formed  first  and  (K12) 
then  being  written  using  the  transpose  of  the  appropriate  [K21]  partitions. 

The  result  of  this  sorting  and  expansion  is  two  tapes,  one  containing  a 
parameter  matrix  in  the  first  file  (giving  the  number  of  partitions  in  each  of 
the  following  files)  and  giving  (Knj  in  the  second  file,  (K12)  in  the  third 
file,  and  [K91]  in  the  fourth  file.  The  [K22]  matrix  is  written  on  a  separate 
tape. 

The  stress  sorting  is  somewhat  simpler,  because  expansion  is  not  required. 
There  is,  however,  one  complication.  The  stress  matrices  contain  columns  for 
all  freedoms  in  the  structure  (both  fixed  and  constrained).  This  requires  that 
the  columns  representing  constrained  freedoms  be  deleted  before  sorting.  Once 
this  is  accomplished,  the  two  stress  matrices  may  be  sorted  in  a  manner  simi¬ 
lar  to  the  stiffness  matrix  but  in  the  column  direction  only.  The  two  parts 
[  S.  ]  and  [  S9  ]  are  written  on  one  tape  with  a  parameter  matrix  (similar 
to  stiffness)  in  the  first  file,  [S^  in  the  second  file,  and  [S2]  in  the  third 
file. 

(4)  Reduction  Procedure 

When  the  sorted  stiffness  and  stress  matrices  have  been  written  on  tape  in 
the  proper  form,  the  MAST  module  then  calls  the  TL01  matrix  package  to  form 
the  reduced  stiffness  and  stress  matrices.  The  TL01  "data  phases"  are  located 
on  tape,  and  the  MAST  module  executes  them  as  requested  by  the  specific  pro¬ 
gram  options  being  used  (figure  16). 

For  general  use,  the  program  will  execute  data  phases  1  through  3  in 
sequence  with  data  phases  P  and  B  being  executed  only  if  the  stress  option  is 
used.  For  program  checkout,  the  reduced  stiffness,  reduced  flexibility,  and 
reduced  stress  matrices  may  be  printed  out.  Refer  to  the  listing  of  the  MAST 
subroutine  in  paragraph  l.b.  (3)(d). 


32 


<11 

1001 

<12 

1001 

<21 

<22 

1001 

1001 

<21 

<22 

<22 

2001 

2001 

2002 

<11 

<12 

<12 

<11 

<12 

3001 

3001 

3002 

3003 

3003 

<21 

<22 

<22 

<21 

<22 

3001 

3001 

3002 

3003 

3003 

<11 

1001 

<12 

1001 

<11 

3001 

<11 

3003 

<12 

3001 

<12 

3002 

<12 

3003 

<21 

1001 

<22 

1001 

<21 

2001 

<22 

2001 

<22 

!2002 

<21 

3001 

<21 

3003 

<22 

3001 

<22 

3002 

<22 

3003 

Figure  15.  Sorted  Stiffness  Matrices 
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c.  Programming  Organization 
(1)  Flow  Diagrams 


On  the  following  pages  are  the  overlay  structure  (figure  17)  and  flow  dia¬ 
grams  (figure  18)  for  the  MAST  module. 

(2)  Tape  Use 

Figures  19  and  20  are  the  tape-use  charts  and  tape  format  for  the  MAST 
module  for  the  RANVIB  system. 

d.  MAST  Subroutine  Listing 

The  following  list  identifies  the  MAST  module  subroutines  and  their  functions. 
The  subroutines  are  listed  in  the  order  they  occur  on  the  phase  I  master  tape. 


Subroutine 

Function 

MAST 

Reads  control  cards  and  controls  execution  of  MAST  module 

PAGHED 

Prints  page  heading 

UNPACK 

Unpacks  constraint-condition  data 

PRINT 

Prints  matrices  or  vectors 

SUBM1 

Controls  generation  of  merge 

GENRAT 

Controls  element  generation 

REDUCE 

Reduces  freedoms  from  elemental  matrices 

INFO 

Reads  in  nodal  data 

PLATE 

Reads  plate  data  and  controls 

MUL1 

Matrix  multiplication,  [C]  =  ( A ]  [  B ) 

MUL2 

Matrix  multiplication,  [C]  =  [  A) T  (B) 

PSTIF 

Controls  local-coordinate  generation  and  elemental  stiffness 

matrix  generation  for  plates 

QUAD 

Controls  elemental  stiffness  generation  for  quadrilateral 
plates 

LAMK 

Performs  coordinate  transformation  from  local-stiffness  to 

structural  stiffness  matrices 
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Figure  1  7.  Mast  Overlay  Structure 
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Figure  18.  MAST  Flow  Chart 
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Figure  18— Continued 


Figure  18— Continued 
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Figure  18— Continued 
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Figure  20.  Phase  I  Master  Tape  Detail 


ABSOLUTE  BINARY  DECK  OF 

PHASE  1 

TL01 

[x] 

~  [K22 ]  [K2l] 

[ 

N]  - 

-  [K,J(X1 

TLOlf 

PRINT 

[Krl 

TLOI 

n=rl  = 

M1 

TLOI  | 

PRINT 

[Fr] 

TLOI  | 

M 

-  tsi] 

-  M'XI 

TLOI  | 

PRINT 

[Srpl 

TLOI  | 

M 

=  [s] 

-  [S2]W 

TLOI  I 

PRINT 

[SrB] 

45 


Subroutine  Function 


KLAMT 

Performs  coordinate  transformation  from  local-stiffness  to 

structural  stiffness  matrices 

TRI 

Controls  generation  of  elemental  stiffness  matrices  for 

triangular  plates 

INP 

Controls  generation  of  in-plane  plate  stiffness  terms 

INPM 

Generates  in-plane  moment  plate  terms 

INPST 

Generates  Ln-plane  plate  stretching  terms 

OUTP 

Controls  generation  of  out-of-plane  plate  stiffness  terms 

OUT  PM 

Generates  out-of-plane  plate  moment  terms 

OUTPSH 

Generates  out-of-plane  plate  shear  terms 

COM  BIN 

Combines  in-plane  terms  or  out-of-plane  terms 

STORE 

Stores  in-plane  and  out-of-plane  terms  in  elemental  stiffness 

matrix 

MOVE 

Matrix  addition,  f B ]  =  [A]  +  [B] 

PMTR 

Generates  coordinate-transformation  matrix  for  triangular 

or  quadrilateral  plates 

SMTR 

Generates  stress-transformation  matrix  for  triangular  or 

quadrilateral  plates 

LOCAL 

Generates  local  coordinates  for  plates  and  checks  for  re¬ 
entrant  corner  and  node  sequencing 

COPLAN 

Checks  quadrilateral  plates  for  coplanarity 

BEAM 

Reads  beam  data  and  controls  the  generation  of  beam- 

element  stiffness  matrices 

TINVR 

Inverts  beam  flexibility  matrix  to  get  beam  stiffness 

SMULT 

Matrix  multiplication-subtraction,  [ C  J  =  [C]  -  f  A  ]  [ B  ] 

MULT 

Matrix  multiplication-addition,  [C]  =  [C]  +  [  A )  f B ]  or 
[  C  ]  =  [C][A]T[b]  or  may  store  results  in  [B] 
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Subroutine  Function 


SBMTR 

Generates  transformation  matrix  for  straight  beams 

SSTIF 

Generates  stiffness  matrix  for  straight  beams 

MAD 

Matrix  addition  for  12  by  12  only,  [A]  =  [A]  +  [B] 

SBGS 

Generates  geometric  stiffness  matrices  for  straight  beams 

OFST 

Generates  offset-transformation  matrix  for  beams 

CSTIF 

Generates  elemental  stiffness  matrix  for  curved  beam 

CBMTR 

Generates  transformation  matrix  for  curved  beams 

MERGE 

Controls  merge  of  structural  stiffness  and  stress  matrices 

SOR 

Sorts  the  partition  identification  number  list  prior  to  merge 

of  stiffness 

MERGBC 

Merges  the  structural  stiffness  matrix 

STRESS 

Controls  merge  of  the  structural  stress  matrices 

MSTRES 

Merges  the  structural  stress  matrices 

SOLN 

Controls  the  sorting  of  the  structural  stiffness  and  stress 

matrices 

TEST 

Tests  the  list  of  partition  identifications  to  determine  if  a 

given  partition  number  is  present 

FKSORT 

Creates  the  control  array  used  to  sort  the  stiffness  and 

stress  matrices 

KFFSRT 

Sorts  the  structural  stiffness  matrix  into  retained  and 

reduced  freedoms 

CONECT 

Controls  the  expansion  of  the  sorted  stiffness  matrix  into 

full  form 

EXPAND 

Expands  the  [Kn]  and  [K22]  matrices  into  full  form 

EXTRAN 

Expands  the  f  K12  ]  and  l  K21J  matrices  into  full  form 

DELETE 

Deletes  the  columns  of  constrained  freedoms  from  the  struc 

tural  stress  matrices 
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Subroutine 


Function 


SSORT  Sorts  the  structural  stress  matrices  into  retained  and 

reduced  parts 


DATA  PHASE  I 

Solves  the  equation 

1  K22]  1 

fx]  =  [K21] 

DATA  PHASE  II 

Calculates 

[Kr]  = 

(Klll 

-  [K12]  [X] 

DATA  PHASE  IH 

Calculates 

[sr]  = 

fs1]  - 

[  S9]  [X  1  (beams) 

DATA  PHASE  IV 

Calculates 

[sr]  - 

[Sj]  - 

[S2]  [X]  (plates) 

2.  INTERMEDIATE  MATRIX  MERGE 

The  stiffness  and  flexibility  matrices  are  merged  in  AMERGE  to  an  N-by-N 
matrix  from  the  partitioned  matrices  output  on  tape  from  the  MAST  module. 

The  stresses  are  merged  and  re-partitioned  in  SMERGE  to  8-by-8  matrices 
for  plates  and  6-by-6  matrices  for  beams. 

The  merged  flexibility  matrix  is  used  in  the  FREMOD  module.  The  stiff¬ 
ness  matrix  is  only  used  when  a  phase  II  option  1  solution  is  desired.  The 
partitioned  stresses  are  used  when  the  stresses  in  phase  II  are  wanted. 

a.  Subroutine  AMERGE  (ITAPE,  NTAPE,  NF1) 

This  subroutine  merges  the  stiffness  |K]  or  flexibility  [F]  matrices. 

Method:  The  matrices  [K]  or  f  F ]  that  are  formed  in  subroutine 

MAST  and  stored  in  row -partitioned  form  are  merged  to 
form  a  N-by-N  matrix  and  stored  on  phase  I  output  tape. 

Input:  Stiffness/flexibility  matrix  on  tape  2 

Output:  Merged  stiffness/flexibility  matrix  on  tape  10 

Error:  READTP/WRTETP  error  messages 

Subroutines  required:  READTP/WRTETP 

Argument  list:  ITAPE — Input  tape  of  stiffness/flexibility 

NTAPE — Output  tape  of  stiffness/flexibility 
NF1 — Number  of  file  marks  to  skip  past  before  reading 
starts.  NF1  =  1  for  the  stiffness  matrix  and  NF1  =  2  for 
the  flexibility  matrix. 


48 


Length: 

33215g 

Flow  chart: 

See  figure  21. 

b.  Subroutine  SMERGE 


Method: 

This  subroutine  merges  the  stresses  from  the  MAST  sub¬ 
routine  and  re-partitions  and  stores  the  matrices  on  the 

phase  I  output  tape.  The  stresses  for  plates  and  beams 

are  re-partitioned  to  8-by-8  and  6-by-6  matrices, 

respectively. 

Input: 

Parameter  matrix  and  stress  matrices  for  plates  and 

beams  from  ITAPE 

Output: 

The  re-partitioned  stress  matrices  are  stored  on  NTAPE. 

The  matrices  for  plates  are  stored  first,  then  the  beam 

stresses  are  stored.  Either  or  both  stresses  may  be 

stored  on  tape. 

Error: 

READTP/WRTETP  error  messages 

Subroutines  required : 

READTP/WRT  ETP 

Argument  list: 

ITAPE — Input  stress  matrices  are  on  this  tape. 

NTAPE — Output  of  the  re-partitioned  stress  matrices 

are  stored  on  this  tape. 

ITEST — This  variable  is  set  to  8  if  the  plate  stresses 

are  to  be  re -partitioned;  6  if  the  beam  stresses  are  to  be 

re-partitioned. 

Length: 

40472g 

Flow  chart: 

See  figure  22. 

3.  VIBRATION  PROGRAM  (FREMOD) 
a.  General  Description 

The  purpose  of  the  FREMOD  module  is  to  calculate  the  natural  frequencies 
and  normal  mode  shapes,  given  the  flexibility  matrix  and  mass  matrix.  This  is 
done  by  solving  the  dynamic  matrix  for  eigenvalues  and  eigenvectors  using  the 
QR  algorithm. 

See  the  macro  flow  chart  (figure  23)  and  organization  chart  (figure  24). 
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Figure  21— Concluded 
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ENTER 


Figure  22.  SMERGE  Flow  Chart 
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Figure  22— Concluded 


ENTER 


Figure  23.  FREMOD  Macro  Flow  Chart 


Figure  24.  FREMOD  Program  Organization 
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Figure  24— Concluded 


b.  Programming  Organization 

The  FREMOD  module  consists  of  a  control  routine  and  seven  subroutines. 
Routine  FREMOD  controls  generation  of  the  eigenvalue-eigenvectors.  The  func¬ 
tions  of  the  seven  subroutines  follow. 


(1)  Subroutine  Descriptions 

Subroutine  VALVCT  calls  six  subroutines  that  together  comprise  the  QR 
algorithm.  The  subroutine  VALVCT  input/output  parameters  are  DYNMAT, 
N,  MODES,  EVAL,  and  VECMAT: 


Parameter 

DYNMAT 


N 

MODES 

EVAL 

VECMAT 


Function 

Dynamic  matrix  (not  returned) 
Size  of  current  dynamic  matrix 
Number  of  modes  desired 
Array  containing  eigenvalues 
Array  containing  eigenvectors 


The  function  of  VALVCT  is  to  generate  eigenvalues  and  eigenvectors. 

Given  the  matrix  equation 

[[D]  -  rM4]  M  =  0  (1) 

where:  [D]  =  dynamic  matrix 

r  =  eigenvalue 
MJ  =  identity  matrix 
{0}  -  eigenvector 

subroutine  VALVCT  and  its  associated  subroutines  find  the  set  of  characteristic 
roots  r  (eigenvalues)  and  the  vectors  {0}  .  Natural  frequencies  are  calculated 
in  the  main  program  from  the  eigenvalues  by  the  equation 


U) 


1 

2  7T  n/F 


(2) 


The  eigenvalue  solution  is  accomplished  using  the  technique  commonly  known 
as  the  QR  algorithm. 
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The  QR  algorithm  is  based  on  the  concept  of  a  similarity  transformation. 

To  illustrate  the  similarity  transformation  and  show  its  usefulness,  let  us  pre¬ 
multiply  equation  (1)  by  the  arbitrary  nonsingular  matrix  [A]  yielding: 

[A  1  [fD]  -  rM-j]  M  =  0  (3) 

Now  assume  a  vector  { X }  such  that  [A]"1{X}  =  {0}  and  substitute  the 
value  into  equation  (3)  yielding: 

[|A]  [D]  -r  [Aim]  fA ]-1{x}  =  0 
|  fA]  [D]  I  A] _1  -  rMj]  {X}  =  0 

Examination  of  equation  (4)  shows  that  the  new  matrix  [A][D]  [  A]  ^ 
the  same  eigenvalues  as  equation  (1).  However,  the  transformation  [A] 
required  to  get  back  to  the  original  vector  space  containing  vectors  {0}  ,  i.  e. 
[A]{0}  =  {x}  .  By  judicious  choice  of  a  series  of  [A]  matrices,  the  form 
of  the  original  matrix  may  be  changed  to  suit  one's  needs.  The  transformation 
represented  by  equation  (4)  is  known  as  the  similarity  transformation.  The 
process  is  as  follows. 

(a)  Step  1 

Subroutine  HESSEN  transforms  the  dynamic  matrix  [D  ]  (N-by-N)  to  "upper- 
Hessenberg"  form  [H]  (h.j  =0,  i  >  j  +  1). 

By  using  similarity  transformations,  the  eigenvalues  are  guaranteed  to  be 
left  unchanged.  One  premultiplication  of  [D  ]  is  required  in  eliminating  the 
terms  below  the  subdiagonal  in  the  j**1  column,  and  postmultiplication  is  required 
to  complete  the  similarity  transformation.  However,  before  premultiplication 
and  postmultiplication  at  the  jth  step,  a  row  and  column  interchange  is  per¬ 
formed  to  ensure  that  the  term  d.^  .  is  larger  than  any  term  below  it  in 
column  j  .  The  equation  is 


(5) 


where  [  Sj  ]  eliminates  the  terms  below  the  subdiagonal  in  column  j  ,  and 
( Uj  ]  performs  the  row  interchange  to  maintain  numerical  stability. 


(4) 

has 

is 
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(b)  Step  2 


Subroutine  QRITER  performs  the  following  calculations: 

A  matrix  [  P  ]  is  found  such  that  [  P  ]  [  H  ]  is  upper  triangular  and 
[  P  ]  [  H  ]  [  P  ]  1  is  again  of  upper-Hessenberg  form.  The  sequence  of  matrices 
[  H  j  ]  ,  [  Hg  ],...(  ]  is  now  formed  as  shown  below: 


H1 

= 

P1 

H 

o 

P1 

H2 

= 

P2 

H1 

P2 

Hk 

- 

Pk 

Hk- 

ll  [P 

It  has  been  demonstrated  (reference  4)  that  this  sequence  converges  to  an 
upper  triangular  matrix  if  the  roots  r  are  real. 

Convergence  is  approximately  inversely  proportional  to  the  ratio  (rj/rj_i)k 
for  the  i^1  root  where  I  r^|  ^  Irgl  >  Ir^l  ...  >  |  rnl  .  This  being  the  case, 
the  acceleration  technique  consists  of  a  shift  of  origin  by  an  amount  that  is  a 
close  approximation  of  the  root  r^  .  It  is  easy  to  find  a  close  approximation 
since  h---*-r-  .  (Actually,  the  roots  of  the  2-by-2  matrix  whose  diagonal  terms 

are  h|_^  and  fm  are  used.)  The  shifting  is  performed  by  subtracting  the 

*  th 

approximation  (say  ?!  )  off  the  diagonal  of  [  H  ]  at  the  k  step.  The  appro¬ 
priate  transformations  are  then  applied  and  then  rj  is  added  back  to  the  diagonal. 
It  is  easy  to  show  that  the  roots  were  unchanged,  but  the  roots  of  the  matrix  [H] 
during  the  actual  step  were  r^  -  r-  .  Therefore,  the  rate  of  convergence  during 
that  step  was  proportional  to  (r^  -  r^/^  -  r- jk  ,  which  will  be  a  large 
number. 

(c)  Step  3 

We  now  have  a  triangular  matrix  in  which  the  diagonal  elements  are  the 
required  eigenvalues.  Subroutine  SORTRT  orders  the  roots  according  to  absolute 
value  and  stores  them  in  a  new  array. 
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(d)  Step  4 


We  have  left  only  the  problem  of  computing  the  vectors  using  the  triangular 
matrix  (Hk)  .  We  first  compute  the  vectors  {0-p}  corresponding  to  the  tri¬ 
angular  matrix  [H^]  .  To  obtain  the  vector  corresponding  to  a  particular 
eigenvalue  (say  the  ith  diagonal  term  of  (H^l  ,  i.e.  )  ,  we  use  the  following 
equation  and  observe  that  all  elements  of  {0-p  }  below  the  i^1  must  be  zero. 

|[Hk]  -  r.m]  {0T}  =  0  (6) 

We  may  arbitrarily  choose  the  value  1.  0  for  the  i^  element  of  {0^}  and 
then  proceed  back  up  the  vector  obtaining  each  successive  term  by  solving  the 
equation  represented  by  the  corresponding  row  in  the  matrix  equation.  This  is 
done  by  subroutine  VECTOR. 

Subroutine  TRANS1  performs  the  following  calculations  in  step  5. 

(e)  Step  5 

The  transformations  that  were  required  to  perform  step  2  are  now  retrieved 
from  tape  and  accumulated  into  the  matrix  [P]-1  .  That  is 


A  vector  {0H}  corresponding  to  the  Hessenberg  matrix  [H]  may  now  be 
computed  as  follows: 

{V  =  [Pfl  <8) 


Subroutine  TRANS2  performs  the  calculations  of  step  6. 


(f)  Step  6 


The  quantities  necessary  to  reconstruct  the  transformations  [  S^  , 

[  Sg  ]  ,  .  .  .  [  Sn  2 1  °f  step  1  were  temporarily  stored  in  the  lower  part  of 
matrix  [D]  for  conservation  of  storage.  (The  matrix  [S]  here  is  not  to  be 
confused  with  the  stress  deflection  matrix  used  earlier. )  Only  n  terms  of 
storage  were  necessary  to  contain  the  information  required  to  reproduce  the 
transformations  [  Ux  ] _1  ,  [  U2 1_1  ,  ...[Un_2l  .  The  following  product  is 

now  computed: 


U, 


n-2 


-1 


n-2 


(9) 
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To  compute  [U^]  ,  [U^]  ^  ,  interchange  rows  jf  and  m  and  form  [U^] 
as  follows: 

U..  =  1,  j  7^  4 ,  m 
JJ 

U.  =  U  -  =  1 

I  m  ml 

All  other  terms  are  zero. 

Also  note  that 

-1 


u. 

= 

u. 

1 

1 

To  compute  [  Sj  ]  ,  [  Sj  ] 


matrix  [  D  ]  and  [  S  ]  =  (  S—  1 


use  the  notation  [  D  )  =  [  ]  for  the  dynamic 

The  terms  below  the  diagonal  in  column  (k  +  1) 
of  the  general  matrix  [Skl  are  -dk+2,k/dk+l,k >  ^k+l, k/dk+l, k  ’  •  *  * 
-dnk/dk+l,  k  ’  In  addition, 


Sij=1’i=j 


All  others  terms  are  zero. 


Equation  (10)  is  the  formulation  for  (  Sj  ]  for  n  =  5  .  It  can  be  readily  noted 
that  [Sj]-1  may  be  obtained  from  (  ]  by  changing  the  sign  of  the  elements 

below  the  diagonal. 


[Sj]  = 


1 
0 

0  — 

0  -- 


0 

0 


0 

0 


0 

0 


31 


21 


41 

i 

21 


51 

1 

21 


(10) 


To  compute  [Pj] 


P.  =  P 


n-1 


(11) 
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where  [  ]  eliminates  the  subdiagonal  terms  in  column  k  .  At  the  time  that 

the  rotational  transformations  [PjJ  are  required,  the  original  dynamic  matrix 
[D]  has  been  reduced  to  Hessenberg  form  [H]  : 

[H]  =  (hyl  (12) 


Specifically  f  P^ ]  is  formed  as  follows: 


A  '  (' 


“kk  "k+l,k) 


+  hf 


1/2 


cos  \  =  hkkLk 


sln  »k  ’  hk+l,kI* 


If 


(Pkl  =  iPijl 

Then 

P..  =  1,  i  /  k,  k+1 

5kk  =  oos  9  ,  Pk>  k+1  =  sin  8 

Pk+l,k  *  -sln9'  5k+l,k+l=cos6 

Pj.  =  0 

for  all  other  i  and  j. 

The  matrix  described  above  is  known  as  Givens'  rotational  matrix.  Note  that 
no  additional  time  is  required  to  compute  the  inverse  since 


tpkl 


-1 


T 


(g)  General-Purpose  Subroutines 


Subroutine 

INRPRD 

READTP \ 
WRTETPj 


Function 

To  form  the  inner  product  of  two  vectors  (See  appendix  II. ) 

Binary  tape  input/ output  subroutines  for  TL01 
compatibility  (See  appendix  II. ) 


(2)  Flow  Diagrams 

Flow  diagrams  for  FREMOD  subroutines  are  shown  in  figures  25  through  32. 
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Figure  25.  VAL  VCT  Flow  Chart 
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ENTER 


TRANSFORM  DYNAMIC 
MATRIX  TO  UPPER- 
HESSENBERG  FORM  [H] 
(hjj  =  0,  i  <  j  +  1). 


RETURN 


Figure  26.  HESSEN  Flow  Chart 


Figure  27.  QRITER  Flow  Chart 


Figure  28.  SOR  TR  T  Flow  Chart 
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FORM  VECTORS. 
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RETURN 


Figure  29.  VECTOR  Flow  Chart 


Figure  31.  TRANS 2  Flow  Chart 


(  ORIGIN  PHASE1  ) 


Figure  32.  FREMOD  Overlay  Map 


c.  FREMOD  Subroutine  List 
Subroutine  Function 

FREMOD  This  is  the  main  program.  It  handles  input,  output,  and 

generation  of  the  dynamic  matrix  from  the  flexibility  and 
mass  matrices.  Subroutine  VALVCT  is  called  for  the  QR 
solution 


VALVCT 


HESSEN 

QRITER 


SORTRT 


Calls  successive  subroutines,  which  together  form  an 
eigenvalue-eigenvector  solution  package  using  the  QR 
algorithm 

Transforms  the  dynamic  matrix  to  upper-Hessenberg  form 

Reduces  the  upper-Hessenberg  matrix  to  a  triangular  matrix, 
the  eigenvalues  being  the  diagonal  terms  (QR  iteration 
scheme) 

Orders  the  eigenvalues  according  to  absolute  value  and 
stores  them  in  a  new  array.  This  array  is  needed  in  form¬ 
ing  the  eigenvectors. 


VECTOR  Computes  the  eigenvectors 

TRANS1  Transforms  the  eigenvectors  (found  using  the  triangular 

matrix)  to  correspond  to  the  upper-Hessenberg  matrix 

TRANS2  Transforms  the  eigenvectors  corresponding  to  the  upper- 

Hessenberg  matrix  to  vectors  corresponding  to  the  dynamic 
matrix 
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IV 

PHASE  II— RANDOM  LOAD  AND  RESPONSE  PROGRAMS 


Phase  II  is  an  integrated  set  of  computer  programs  for  determining  sonic 
loads  and  random  structural  responses.  The  execution  of  this  phase  is  con¬ 
trolled  by  the  PHASE2  routine.  The  RANLOD  module  and  RANSO  modules  are 
called  from  the  control  program.  The  program  listings  for  phase  II  are  included 
in  appendix  IV. 

1.  RANDOM  LOADING  MODULE  (RANLOD) 

a.  General  Description 

RANLOD  generates  force  cross-power  spectral  density  (cross-PSD)  matrices 
describing  the  applied  forces.  The  mathematical  model  is  based  on  properties 
of  decayed  progressive  sound  waves.  The  RANLOD  module  consists  of  five 
FORTRAN-coded  subroutines  and  associated  system  and  general  input/output 
(I/O)  subroutines. 

Other  loading  modules  can  be  used  in  place  of  RANLOD  when  the  analysis 
requires  a  different  form  of  force  loading.  These  modules  must  be  compatible 
with  the  basic  RANVIB  system. 

In  addition  to  basic  problem  information,  RANLOD  requires  data  input  on 
cards  describing  the  panel  geometry,  wave  data,  and  option  control  parameters. 

A  detailed  discussion  of  the  input  and  card  format  is  contained  in  the  Engineering 
User’s  Guide,  reference  3. 

Figure  33  illustrates  the  logical  placement  of  RANLOD  in  the  RANVIB 
system.  The  overlay  structure  is  discussed  in  section  IVl.b. 

The  RANLOD  module  is  called  once  during  the  execution  of  phase  II  to 
generate  the  required  matrices.  In  addition  to  the  frequencies,  solution  options, 
and  control  parameters  stored  in  the  labeled  common  blocks  by  the  phase  II 
control  program,  RANLOD  reads  card  inputs.  It  then  proceeds  to  generate  the 
force  cross-PSD  matrices  for  the  required  solution  option.  They  are  stored  on 
tape  and  printed  as  they  are  generated.  The  matrices  are  stored  on  tape  in  a 
compatible  format  for  the  various  solution  options  the  user  desires.  The 
printing  is  controlled  by  the  user  as  described  in  the  card  input.  Figure  34 
illustrates  RANLOD  input/output  data  flow. 
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Figure  33.  RANLOD  Placement 


•  FREQUENCIES 

•  SOLUTION  OPTIONS 

•  CONTROL  PARAMETERS 
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•  PROBLEM  ID 
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FORCE  CROSS-PSD 
MATRICES  FOR 
SOLUTION  MODULES 


Figure  34.  RANLOD  Input /Output  Diagram 


70 


The  five  subroutines  that  form  the  RANLOD  module  are  as  follows: 


Subroutine 

RANLOD 

ARIA 

CONST 

NOISOR 

OUTPUT 


Function 

Control  subroutine  that  reads  input  and  problem  initializations 
and  calls  all  subroutines  needed  for  generation 

Calculates  the  areas  associated  with  the  retained  nodes 

Calculates  problem  constants  needed  in  generation 

Computes  the  force  cross-PSD  matrices 

Controls  printing  and  formation  of  binary  output  tapes 


The  logic  flow  of  the  RANLOD  module  is  shown  in  figure  35. 

(1)  Input/Output  Functions 

All  card  inputs  are  via  logical  tape  5,  and  all  printed  outputs  are  via 
logical  tape  6.  Logical  tapes  2,  17,  and  14  are  used  for  all  binary  outputs 
of  the  force  cross-PSD  matrices.  These  tapes  are  written  from  subroutine 
OUTPUT  using  subroutine  WRTETP.  A  detailed  map  of  these  tapes  is  given 
in  the  description  of  subroutine  OUTPUT. 


(2)  Restrictions 

The  RANLOD  restrictions  are  discussed  in  detail  in  the  Engineering  User’s 
Guide,  reference  3.  These  restrictions  are  basic  problem  size  and  mathematical 
limitations  in  analyses.  If  it  is  desired  to  replace  RANLOD  with  another  loading 
module,  the  following  items  must  be  adhered  to. 

(a)  The  labeled  common  blocks  BLK1,  BLK2,  and  BLK3  must  be  retained  and 
the  size  maintained  compatible  with  phase  II  definitions.  The  force  cross- 
PSD  matrix  size  must  be  maintained  to  less  than  or  equal  to  the  phase  II 
limits. 

(b)  The  binary  tape  output  of  the  force  cross-PSD  matrices  must  be  maintained 
in  the  compatible  format  for  the  solution  modules. 
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Figure  35.  RANLOD  Subroutine  Flow 


b.  Programming  Organization 
(1)  Subroutine  Descriptions 

This  section  discusses  the  purpose,  methodology,  restrictions,  and 
inputs /outputs  of  the  five  FORTRAN  subroutines. 

(a)  Subroutine  RANLOD 

Subroutine  RANLOD  is  the  controlling  routine  for  the  loading  module.  It 
is  called  by  the  phase  II  control  program  and  returns  to  this  program  when 
generation  is  complete. 

Method:  Subroutine  RANLOD  accepts  control  from  the  phase  II 

main  program  and  controls  the  generation  of  the  force 
cross-PSD  matrices.  It  uses  the  information  in  labeled 
common  blocks  BLK1,  BLK2,  and  BLK3  to  generate 
the  required  solution  option.  Labeled  common  blocks 
BLK4,  BLK5,  and  BLK6  are  established  for  communica¬ 
tion  between  RANLOD  subroutines. 

Figure  36  is  a  flow  chart  of  the  RANLOD  subroutine. 

Input:  Input  is  via  two  modes.  The  first  is  labeled  common 

from  phase  II  control.  The  second  mode  of  input  is  cards. 
The  content  and  card  format  are  discussed  in  detail  in 
reference  3. 

Error  diagnostics:  None 

Subroutines  required:  ARIA,  CONST,  NOISOR 
Argument  list:  None 

Length:  37001g 

(b)  Subroutine  ARIA 

Subroutine  ARIA  computes  the  areas  associated  with  the  retained  nodes  in 
the  structural  idealization. 

Method:  Using  the  set  of  line-to-origin  distances,  the  area  A 

for  node  k  is  calculated  using 

Ak  * 1/4  (xi+i  -  xi-i>  <yj+i  -  yj-i> 
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Figure  36.  RANLOD  Flow  Chart 


where:  k  =  1,  number  of  retained  nodes 

i  =  2,  number  of  nodes  in  x  direction 

j  =  2,  number  of  nodes  in  y  direction 

Figure  37  illustrates  subroutine  ARIA  flow. 

Input:  Input  is  via  labeled  common. 

Error  diagnostics:  None 

Subroutines  required:  None 

Argument  list:  None 

Length:  101g 

(c)  Subroutine  CONST 

Subroutine  CONST  calculates  the  angle  9  and  trace  velocity  ct  .  Angle 
9  defines  the  direction  that  the  trace  of  the  pressure  wave  fronts  propagate 
over  the  panel  surface. 


Method:  Subroutine  CONST  is  only  called  for  a  progressive  wave. 

The  methodology  and  input  control  for  this  calculation  is 
described  in  reference  3.  Figure  38  illustrates  subroutim 
CONST  flow. 


Input: 


There  is  no  input  except  through  the  subroutine  argument 
list. 


Error  diagnostics:  None 
Subroutines  required:  None 

Argument  list:  CX  input — The  phase  velocity  along  the  panel  in  the  x 

direction 

CY  input — The  phase  velocity  along  the  panel  in  the  y 
direction 

CT  output — Trace  velocity 

THETA  output —  9  ,  the  angle  between  the  direction  of 
sound  propagation  and  the  x  and  y  axes  of  the  panel 

Length:  141g 
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ENTER 


Figure  37.  ARIA  Flow  Chart 


Figure  38.  CONST  Flow  Chart 


(d)  Subroutine  NOISOR 


Subroutine  NOISOR  calculates  the  force  cross-PSD  matrices.  It  receives 
control  of  the  generation  from  routine  RANLOD  and  returns  to  this  sub¬ 
routine  when  generation  is  complete. 

Method:  The  detailed  mathematical  model  from  which  subroutine 


Input: 

NOISOR  computes  force  cross  PSD  is  discussed  in 
reference  1.  Figure  39  describes  the  flow  of  subroutine 
NOISOR.  The  subroutine  computes  the  matrices  in  a 

direct  manner  with  the  mathematical  model.  The  one 
exception  to  this  is  the  computation  of  the  separation 
distances  and  from  the  set  of  line-to-origin 

distances  and  y^  .  The  separation  distances  are 

calculated  as  needed  in  the  calculation  of  force  cross 
PSD.  This  is  done  to  conserve  storage.  The  equations 
used  in  the  separation  calculation  are  as  follows: 

£..  =  x.  -  x. 

U  J  i 

and 

V- ■  =  y.  -  y. 

The  computation  of  the  subscripts  is  done  by  use  of 
FORTRAN  IV  function  subroutine  MOD.  This  is  done  to 
take  advantage  of  the  repeating  properties  of  the  nodal 
geometry.  A  detailed  flow  chart  of  the  separation  calcu¬ 
lation  in  program  notation  is  shown  in  figure  40. 

Input  to  subroutine  NOISOR  is  via  labeled  common  and 
the  subroutine  argument  list. 

Error  diagnostics: 

None 

Subroutines  required:  OUTPUT 

Argument  list:  ILIM  input — Limit  on  outer  frequency  loop 

KLIM  input — Limit  on  inner  frequency  loop 
D  input — Decay  constant 
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Figure  39.  NOISOR  Flow  Chart 


Figure  40.  Separation-Algorithm  Flow  Chart 
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CT  input — Trace  velocity 
THETA  input —  6  ,  propagation  angle 

CX  input — Phase  velocity  in  x  direction 
CY  input — Phase  velocity  in  y  direction 

Length:  60  lg 

(e)  Subroutine  OUTPUT 

Subroutine  OUTPUT  is  called  from  subroutine  NOISOR  each  time  the  matri. 

output  is  required,  i.e.  eachfrequency  computation.  The  return  is  to  subroutine 

NOISOR  upon  completion  of  OUTPUT. 

Method:  The  subroutine  has  two  output  functions.  One  is  to  print 

the  force  cross-PSD  matrices  for  as  many  frequencies  as 
requested  by  the  user.  The  other  is  to  write  the  force 
cross-PSD  matrices  on  binary  tape  in  a  format  compatible 
with  the  solution  modules.  Item  2  is  accomplished  by  the 
use  of  subroutine  WRTETP,  which  is  discussed  in 
appendix  I.  Figure  41  describes  the  general  flow  of 
subroutine  OUTPUT. 

Input:  Input  is  via  labeled  common  and  the  subroutine  argument 

list. 

Error  diagnostics:  The  error  return  from  subroutine  WRTETP  is  tested,  and 

the  appropriate  comment  printed  if  an  error  has  occurred. 

Subroutines  required:  WRTETP 

Argument  list:  NPHI  input — Count  of  the  number  of  frequencies  for  which 

calculation  has  been  completed 

OMG  input — The  value  of  the  current  frequency  (used  in 
printing  for  identification) 

Length:  573g 

(2)  Tape  Use 

The  detailed  maps  of  the  binary  tapes  for  the  various  solution  options  are 

shown  in  figure  42. 
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Figure  41.  OUTPUT  Flow  Chart 
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Figure  42.  Binary  Output  Tape  Maps  from  RANLOD 
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2.  RANDOM-RESPONSE  SOLUTION  PROGRAM  (RANSO) 


a.  General  Description 

(1)  Purpose — Logical  Organization 

The  purpose  of  the  RANSO  (random-response  solutions)  module  is  to  calcu¬ 
late  random  deflections  and  stress  response  solutions  via  matrix  methods  for 
complex  structures  subjected  to  random  excitations.  All  matrix  manipulations 
and  solutions  are  performed  in  real  matrix  form .  The  logical  flow  through  the 
RANSO  solution  is  shown  in  figure  43.  There  are  three  solution  options: 

(1)  Option  1 — General  viscous  damping 

(2)  Option  2 — Normal  modes 

(3)  Option  3 — Normal  modes  without  cross  terms 

Options  2  and  3  are  used  when  the  excitation  pressures  vary  slowly  with 
frequency,  i.e.  broadband.  When  the  excitation  is  not  broadband,  option  1  is 
used.  For  each  option,  there  are  four  basic  solutions  involved: 

(1)  Deflection  cross  PSD 

(2)  Deflection  covariance  and  second  spectral  moments 

(3)  Stress  cross  PSD 

(4)  Stress  covariance  and  second  spectral  moments  within  elements 

(2)  Input/Output  Functions 

The  data  from  the  phase  I  output  tape  will  be  used  as  part  of  the  input  of 
phase  II.  Additional  input  from  cards  is  required  as  discussed  in  the 
Engineering  User’s  Guide,  reference  3.  All  intermediate  results  will  be 
stored  on  scratch  tapes  for  temporary  storage  before  proceeding  to  the  next 
operational  subroutine . 

(3)  Phase  II  RANSO  Subroutines 

There  are  two  types  of  subroutines  in  the  RANSO  module.  They  are  the 
standard  FORTRAN  IV  subroutines  and  TL01  subroutines.  The  FORTRAN  IV 
subroutines  are  described  as  follows: 

(a)  Method 

(b)  Input /output 
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Errors 


(c) 

(d)  Subroutines  required 

(e)  Argument  list 

(f)  Subroutine  length — number  of  storage  locations  in  octal  required  by  the 
subroutine  when  compiled  on  the  7094  Mod  II  Version  13 

(g)  Flow  diagrams 

The  subroutines  that  are  written  in  TL01  matrix  language  (appendix  I)  are 
described  as  follows: 

(a)  A  description  of  the  subroutine 

(b)  Input  tape  storage  and  output  tape  storage 

(c)  Flow  diagram 

A  discussion  of  READTP/WRTETP  error  messages  is  given  in  appendix  I. 


(4)  FORTRAN  and  TL01  Flow-Diagram  Conventions 
(a)  Symbols  in  TL01  Flow  Charts 


84 


Symbol 


Definition 


( t  )p 

or  P(  t  ) 

n 

Matrix  operation 

Multiply  the  results  from  the  preceding  block  by  P. 

Number  of  stress  matrices 

m 

Number  of  mode  shapes 

NF 

Number  of  frequencies 

(b)  Symbols  for  FORTRAN  Diagrams  Only 
Symbol  Definition 


* 

File  mark  on  tape 

@— °rQ-~ 
-*0 

Input  from  tape  1 

Output  on  tape  1 

JD 

Deflection  covariance  matrix 

CPSD 

Cross  PSD 
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Figure  43.  RAN  SO  Flow  Diagrams 
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Figure  43— Continued 
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Figure  43- Continued 
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Figure  43-Continued 
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Figure  43— Continued 
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Figure  43-Continued 
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Figure  43— Concluded 


RANSO  Subroutine  Listing 

Function 

Impedance  matrix 

Calculates  the  constants  used  in  the  complex  matrix  integration 
using  the  trapezoidal  rule 

Admittance  integral  scalars  used  in  option  2  deflection  covariance 
calculations 

Multiplies  the  co-PSD  and  quad-PSD  matrices  by  the  admittance 
scalar  integrals  used  in  the  deflection  covariance  calculations  and 
sums  the  products 

Calculates  the  scalars  in  the  deflection-spectral-moment  equations 
for  option  3 
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Subroutine  Function 


SECM2 

Calculates  the  second-spectral-moment  scalars  for  option  2 

deflection  covariance 

DSECM3 

Calculates  the  deflection  second  spectral  moments  for  option  3 

CQCPSD 

Multiplies  the  co-PSD  and  quad-PSD  matrices  by  the  admittance 

scalars  and  sums  the  products  for  option  2 

ADMIT2 

Admittance  scalars  used  in  option  2  cross-PSD  calculations 

ADMIN3 

Admittance  integral  scalars  used  in  option  3  deflection  covariance 

calculations 

ADMIT  3 

Admittance  scalars  used  in  option  3  cross-PSD  calculations 

ADDMAT 

Performs  the  matrix  summation  for  option  2  and  option  3  deflection 

covariance  and  cross-PSD  calculations 

TAPOS 

Positions  the  master  tape  in  proper  positions  to  start  reading 

TL01  data  for  all  options 

SUM2 

Performs  the  matrix  summation  for  option  2  deflection  covariance 

and  cross-PSD  calculations 

SUM3 

Performs  the  matrix  summation  for  option  3  deflection  covariance 

and  cross-PSD  calculations 

SUMT 

Sums  the  option  2  and  option  3  matrices 

COMINV 

Inverts  a  complex  matrix 

CPSD1 

Calculates  the  deflection  response  cross  PSD  for  option  1 

SRESP1 

Calculates  stress  response  cross  PSD  for  option  1 

TRAPM 

Performs  the  complex  matrix  integration  over  all  frequencies  to 

form  the  deflection  covariance  matrices  for  option  1 

SJNT1 

Calculates  joint  stress  cross-PSD  matrix  for  option  1 

DSECM1 

Calculates  deflection  second-spectral-moment  matrix  for  option  1 

SSECM 

Calculates  stress  second  spectral  moments  for  option  1 

DJNT3 

Calculates  deflection  covariance  matrix  for  option  3 
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Subroutine  Function 


DJNT2 

Calculates  deflection  covariance  matrix  for  option  2 

SJNT2 

Calculates  stress  covariance  matrix  for  option  2 

DSECM2 

Calculates  deflection  second-spectral-moment  matrix  for  option  2 

CPSD3 

Calculates  deflection  cross- PSD  matrix  for  option  3 

CPSD2 

Calculates  deflection  cross  PSD  for  option  2 

SJNT3 

Calculates  stress  covariance  matrix  for  option  3 

DSJNT3 

Calculates  stress  second-spectral-moment  matrix  for  option  3 

SRESP3 

Calculates  stress  cross  PSD  for  option  3 

PRINTA 

Prints  the  deflection  cross -PSD  matrices  (option  1) 

PRINTB 

Prints  the  stress  cross- PSD  matrices  for  plates  and  beams 

(option  1) 

PRENTC 

Prints  the  deflection  covariance  matrices  (option  1) 

PRINTD 

Prints  the  stress  cross-PSD  matrices  in  option  3  and  prints  the 

stress  covariance  matrix  in  all  options 

PRINTE 

Prints  the  stress  cross-PSD  matrices  (option  2) 

b.  Option  1  Solution  Program — General  Viscous  Damping 
(1)  Organization 

Option  1  is  time  consuming,  because  there  is  a  complex  matrix  inversion 
involved  for  each  frequency.  When  the  excitation  is  not  broadband,  the  mean- 
square  deflections  and  stresses  are  calculated  by  numerical  integration. 

The  damping  matrix  [  C  ]  is  card  input.  The  stiffness  matrix  [  K  ]  and 
the  mass  matrix  [M]  come  from  the  phase  I  output  tape.  The  desired  fre¬ 
quencies  for  which  the  responses  are  formed  are  card  inputs. 

The  solution  steps  and  their  associated  subroutine  names  are  described 
below.  The  limitations  are  as  follows: 


N  <  60 
m  <  25 
NF  <  60 
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Step  1:  The  excitation-force  matrices  co-power  [Cp(cu.)]  and  quad-power 

[QF  (c^)]  spectral  densities  for  each  desired  frequency  are  generated 
using  subroutine  RANLOD. 

Step  2:  The  impedance  matrix  is  calculated  in  subroutine  PE  DAN  and  is  divided 
into  a  real  part  -(*?  [ M  ]  +  [K]  and  an  imaginary  part  U/[C]  .  These 
matrices  are  used  as  inputs  to  the  admittance -matrix  formation. 

Step  3:  The  admittance  matrix  [ H (ice) ]  is  calculated  for  all  frequencies  using 
the  impedance  matrix  as  the  input.  A  complex  matrix-inversion 
process  is  used  in  the  calculation  for  the  admittance  matrix  at  each 
specified  frequency. 

The  TL01  subroutine  COMINV  is  used  to  find  the  complex  matrix 
inverse.  See  section  IV  2.b.  (2)(3)  for  the  subroutine  flow  chart  and 
a  description  of  the  method.  Thus, 

I  2  f1 

[H(u4]  =  |-w  [M]  +  icu  [C]  +  [K]  | 

The  admittance  matrix  is  divided  into  a  real  part  [J(cu)]  and  an 
imaginary  part  (L(w)]  and  is  stored  on  a  scratch  tape  for  the  cross- 
PSD  solution.  Hence, 

[H(iu>)l  ^  [J(u*l  -  i  [  L  (gj)  ) 

Step  4:  The  deflection  cross-PSD  matrices  f <i>^(co) ]  are  calculated  for  all  fre¬ 
quencies  by  TL01  subroutine  CPSD1.  See  section  IV  2.b.  (2)(j).  The 
real  part  is  formed  by  use  of  the  relationship: 

(C6(U))]  =  [J]  ([CpM]  [J]  +  [Qp(w)J  [L] ) 

+  (L J  ( f C F (uj) ]  [L]  -  [Qp(u>)]  [J]) 

The  imaginary  part  is  formed  by  use  of  the  relationship: 

(Q6(cu)]  =  [L]  ([CpH]  [J]  +  IQpMJ  IL]) 

-[J]  ([Cp(w)l  [L]  -  [ Q F (oj) ]  [J]) 

The  cross  PSD  calculated  at  each  frequency  is  stored  on  tape  for 
later  use  in  the  deflection  second-spectral-moment  calculation. 
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Step  5:  If  the  stress  cross-PSD  solution  is  desired,  TL01  subroutine  SRESP1 
is  used.  Thus, 

=  [s]  [S]T 

The  stress  matrices  [  S]  come  from  the  phase  I  output  tape  and  the  cross 

PSD  [$,(ui)]  are  formed  in  step  4  above.  See  section  IV  2.b.  (2)  (f). 

6 

Step  6:  If  the  deflection  covariances  are  desired,  the  cros  s  PSD’s  are  numeri¬ 
cally  integrated  using  the  trapezoidal  rule.  To  obtain  a  desired 
accuracy,  an  adequate  number  of  cross  PSD’s  should  be  defined  over 
the  frequency  range.  The  constants  used  in  the  trapezoidal  method  are 
calculated  in  subroutine  CONS,  section  IV  2.b.  (2)(c),  and  stored  on  tape. 
These  scalar  constants  are  multiplied  by  the  N-by-N  cross-PSD 
matrices  and  summed  over  the  frequency  range  to  calculate  the  deflec¬ 
tion  covariance  in  TL01  subroutine  TRAPM.  See  section  IV  2.b.(2)(g). 

Step  7:  If  the  stress  covariance  matrices  are  desired,  TLOl  subroutine  SJNT1 
is  used.  See  section  IV  2.  b.  (2)(h).  Thus, 

=  ts]  t^3rl  fslT 

Step  8:  The  deflection  second  spectral  moments  are  obtained  by  multiplying 
the  cross  PSD  formed  in  step  4  by  the  square  of  the  frequency 
and  by  constants  from  CONS  and  then  summing  over  all  frequencies. 

This  is  accomplished  in  subroutine  DSECM1.  See  section  IV  2.b.  (2)(d). 

Step  9:  The  stress  second  spectral  moments  are  calculated  in  TLOl  subroutine 

SSECM,  section  IV  2.b.  (2)(i),  by  using  the  N-by-N  matrix  calculation 

in  step  8.  This  matrix  is  premultiplied  by  the  stress  matrix  [  S  ]  and 

T 

postmultiplied  by  [  S  ] 

(2)  Subroutine  Descriptions 

(a)  Subroutine  RANLOD  (Refer  to  section  IV  1. ) 
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(b)  Subroutine  PEDAN  (figure  44) 

Method:  The  impedance  real  and  imaginary  matrices  are 

calculated  for  NF  frequencies. 

•  Real  part:  [M]  +  ( K ] 

•  Imaginary  part:  u;(C] 

Input:  Mass  matrix  [Ml  and  the  stiffness  matrix  ( K 1  come 

from  the  phase  I  output  tape.  The  damping  matrix  I C  ) 
is  card  input. 

Output:  The  impedance  matrices  (real  part  and  imaginary  part) 

are  stored  on  a  scratch  tape. 

Error:  Standard  READTP/WRTETP  error  messages 

Subroutines  required:  READTP/WRTETP 
Argument  list:  None 

Length:  40526g 


Figure  44.  PEDAN  Flow  Chart 
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(c)  Subroutine  CONS  (figure  45) 


Method: 


This  subroutine  calculates  the  constants  C  used  in 
the  trapezoidal  TL01  subroutine  TRAPM  at  NF 
frequencies  (uk)  . 

Form  H.  -w.  where  i  =  l,NF-l 

1  l+l  i  ’ 


Hence,  =  (H.^  +  H^)  ,  where 


and 


H  2  H 

n  c  _  (NF-1) 

1  2  *  CNF  2 


i  =  2 ,  NF- 1 


Input:  Frequencies  u>.  are  stored  in  labeled  common. 

Output:  Constants  C^i  =  1,  NF)  are  written  on  a  scratch  tape. 

Error:  Standard  WRTETP  error  messages 

Subroutines  required:  WRTETP 

Argument  list:  None 

Length:  526g 


Figure  45.  CONS  Flow  Chart 
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Method: 


(d)  Subroutine  DSECM1  (figure  46) 

The  deflection  second  spectral  moments  are  calculated  by 
multiplying  the  cross  PSD  found  in  subroutine  C  PSD1  by 
cj.2  C.  .  Thus, 


M 


2 

6 


m 

=  E  [*,(«*)] 

i=l  6 


C. 

l 


Input:  Constants  Cj  and  cross-PSD  matrices  [<l>g(icjp]  come 

from  a  scratch  tape. 

Output:  Deflection  second  spectral  moments  are  stored  on  tape  12. 

Error:  Standard  READTP/WRTETP  error  messages 

Subroutines  required:  READTP/WRTETP 
Argument  list:  None 

Length:  405 14Q 

-  O 


Figure  46.  DSECM1  Flow  Chart 
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(e)  TL01  Subroutine  COMINV 


Solve  for 

[Cl  =  ([A]  -  i  [B])"1 
The  real  part  can  be  expressed  as 

([A]  +  [B]  [A]-1  [B]  ) 


and  the  imaginary  part  as 

-  (A)"1  [B]  ^[A ]  +  [B]  [A]-1  [B] 

where:  A  =  real  part  of  a  complex  matrix 

B  =  imaginary  part  of  a  complex  matrix 

The  flow  chart  for  the  complex  matrix-inversion  subroutine  is  shown  in 
figure  47. 


INPUT  TAPE  STORAGE  OUTPUT  TAPE  STORAGE 


Figure  47.  COMINV  Flow  Chart 
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(f)  TL01  Subroutine  SRESP1 


The  stress  response  cross-PSD  matrices  [$a(uu)]  are  calculated  as  shown 
in  figure  48. 


Figure  48.  SRESP1  Flow  Chart 
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(g)  TL01  Subroutine  TRAPM 


The  deflection  covariance  matrix  [<5^6r  ]  is  found  by  integrating  the  cross- 
PSD  [*j(iuj)l  matrices  over  NF  frequencies  by  the  trapezoidal  method.  Refer 
to  figure  49. 


INPUT  TAPE  STORAGE 


OUTPUT  TAPE  STORAGE 


TAPE  14:  PARAMETER 

TAPE  4:  INTEGRATION  CONSTANT 

TAPE  15:  REAL  PART 

CPSD  MATRICES 
TAPE  16:  I  MAG  PART 

CPSD  MATRICES 


TAPE  12:  DEFLECTION  COVARIANCE  REAL  & 
IMAG  MATRICES  AT  NF  FREQ 


Figure  49.  TRAPM  Flow  Chart 
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(h)  TL01  Subroutine  SJNT1 

The  stress  covariance  matrix  [a  a,  ]  at  NF  frequencies  is  calculated  as 

S  l 

shown  in  figure  50. 


INPUT  TAPE  STORAGE 


TAPE  14:  PARAMETERS 
TAPE  12:  DEFLECTION  COVARIANCE 
MATRIX 

TAPE  10:  STRESS  MATRICES _ 


OUTPUT  TAPE  STORAGE 


TAPE  3:  STRESS  COVARIANCE  MATRIX 
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(i)  TL01  Subroutine  SSECM 


The  stress  second-spectral-moment  matrix  is  calculated  as  shown  in 
figure  51. 


INPUT  TAPE  STORAGE 

OUTPUT  TAPE  STORAGE 

TAPE  14: 
TAPE  10: 
TAPE  12: 

PARAMETERS 

STRESS  MATRICES 
DEFLECTION  COVARIANCE. 
MATRIX 

TAPE  3:  STRESS  SECOND 

SPECTRAL  MOMENTS 

Figure  51.  SSECM  Flow  Chart 
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(j)  TL01  Subroutine  CPSD1 


The  deflection  response  cross-PSD  matrices  are  calculated  for  option  1. 
Refer  to  figure  52. 


INPUT  TAPE  STORAGE  OUTPUT  TAPE  STORAGE 


TAPE  12 
TAPE  14 
TAPE  17 

MATRICES  FROM  COMINV  [J]  &  [L] 
PARAMETERS 

CO-PSD  AND  QUAD-PSD  MATRICES 
fCp(w)]  &  [Qp  (u))] 

TAPE  15:  REAL  CPSD  MATRICES 

TAPE  16:  IMAGINARY  CPSD  MATRICES 

(m) - *-  PARAMETERS  {p} 

® — 


I 


(H> 


[L] 

I 


[0F  (w)] 


[Qp  ( w )]  [L] 

~~r~ 


12) - ► 


[Cp  (u> )] 

m 


ui 

I 


[Cp(cu)]  [J]  +  [Qp(w)]  [L] 


I 


12) - ► 


[J]  (t) 


<D 


[L] 

I 


[L]  {[Cp  (OJ )]  [J]  +  [Qp  ( oj ) ]  [L]}  J — KD 


Figure  52.  CPSD1  Flow  Chart 


108 


Figure  52.  —Concluded 
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c.  Option  2  Solution  Program — Normal  Modes 
(1)  Organization 

The  solution  of  option  2  is  divided  into  two  segments:  (1)  covariance,  and 
(2)  cross  PSD.  For  simplicity  ,  each  segment  is  divided  into  a  part  that 
calculates  contributions  from  like  modes  (same  as  option  3  and  identified  as 
option  3)  and  a  part  that  calculates  contributions  from  unlike  modes.  The  sum¬ 
mation  of  the  like  and  unlike  modal  contributions  results  in  the  option  2  solution. 

The  effects  of  some  of  the  cross  modal  terms  are  insignificant.  A 
parameter  K  can  be  specified  that  limits  the  number  of  cross  modal  terms 
retained  in  the  calculation  of  the  solution.  Cross  PSD's  are  generated  in  two 
sets.  The  first  set  is  for  the  natural  frequencies  and  the  second  set  is  for  the 
cross-modal  terms.  Frequencies  for  the  cross  modal  term  are  in  the  order 

u>.  +  <jJ. 


where:  i  =  1,  2  .  .  .  ,  m  -  1 

j  =  i  +  1 . i  +  K  <  m 

K  =  an  input  parameter  defining  the  number  of  cross  terms  in  the 
calculation 

m  =  number  of  natural  frequencies 
The  limitations  are  as  follows: 

N  <  90 
m  <  25 
NF  <  90 
1  <  K  <  m  -  1 

(a)  Segment  1 — Deflection  Covariance 

Step  1:  The  excitation  co-PSD  (real  part)  and  quad-PSD  (imaginary  part) 

matrices  are  generated  in  subroutine  RANLOD.  The  excitations  are 
calculated  for  like  and  unlike  modes. 

Step  2:  The  admittance  integral  scalars  for  option  3  are  calculated  in  subroutine 
ADMIN3.  See  section  IV  2.  d.  (2)(b). 
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Step  3:  The  deflection  covariance  matrices  for  like  modes  are  generated  in 

TL01  subroutine  DJNT3,  section  IV  2.  d.  (2)(f),  for  each  normal  mode. 

In  subroutine  ADDMAT,  section  IV  2.d.  (2)(c),  the  deflection  co- 
variance  matrices  are  summed  over  m  normal  modes. 

Step  4:  The  admittance  integral  scalars  are  calculated  in  subroutine  ADMIN2, 
section  IV  2.  c.  (2)(c).  If  a  parameter  K  is  specified,  there  are 
K  cross-product  terms  of  the  admittance  integral  scalars  formed  for 
each  mode. 

Step  5:  In  subroutine  CQJD,  section  IV  2.  c.  (2)(e),  the  excitations  calculated  in 
step  1  are  combined  with  the  admittance  integral  scalars  calculated  in 
step  4,  and  the  resultant  matrices  are  stored  on  a  scratch  tape  that  is 
used  in  deflection  covariance  subroutine  DJNT2.  See  section  IV 
2.c.  (2)(m). 

Step  6:  The  deflection  covariance  for  K  cross  terms  for  each  mode  are  calcu¬ 
lated  in  TL01  subroutine  DJNT2.  Real  and  imaginary  parts  of  the 
deflection  covariance  matrices  are  generated  for  each  cross  mode 
and  stored  on  scratch  tape.  Subroutine  ADDMAT  sums  all  the  cross- 
modal  deflection  covariance  matrices  for  the  real  and  imaginary  parts. 

Step  7:  The  real  part  of  the  matrix  calculated  in  step  6  is  added  to  its  transpose 
to  form  the  real  part  of  the  deflection  covariance  matrix.  The  imagi¬ 
nary  part  of  the  matrix  calculated  in  step  6  is  added  to  its  negative 
transpose  to  form  the  imaginary  part  of  the  deflection  covariance  ma¬ 
trix.  This  is  done  in  subroutine  SUMT.  See  section  IV  2.c.(2)(f). 

Step  8:  The  deflection  covariance  matrices  of  like  and  unlike  modes  are  cal¬ 
culated  in  subroutine  SUM2,  section  IV  2.c.  (2)(g).  This  subroutine 
adds  contributions  from  like  modes  obtained  in  option  3  to  contributions 
from  the  unlike  modes  obtained  in  option  2. 

Step  9:  The  stress  covariance  matrices  are  generated  in  TL01  subroutine 
SJNT2,  section  IV  2.  c.  (2)(n).  The  deflection  covariance  matrices 
(real  and  imaginary  parts)  are  premultiplied  by  [S]  and  postmultiplied 
by  [S]T  . 

Step  10:  The  second-spectral-moment  scalars  of  option  3  are  calculated  in 
subroutine  SECM3.  See  section  IV  2.  c.  (2)(h). 
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Step  11: 


Step  12: 


Step  13: 


Step  14: 


Step  15: 


Step  16: 


Step  17: 


Step  1: 


The  second-spectral-moment  matrices  for  like  modes  (same  as  in 
option  3)  are  calculated  in  TL01  subroutine  DJNT3,  section  IV  2.  d.  (2)(f), 
for  each  mode  and  stored  on  tape.  Subroutine  ADDMAT  takes  the  m 
deflection  second-spectral-moment  matrices  and  sums  for  the  normal 
modes. 

The  scalars  from  the  integrals  used  in  the  second  spectral  moments 
are  calculated  in  subroutine  SECM2,  section  IV  2.c.  (2)(i),  for  like  and 
unlike  modes. 

The  excitation  matrices  are  combined  with  the  scalars  (same  as  in 
step  5  with  different  scalar  values)  in  subroutine  CQJD,  and  the 
resultant  matrices  are  stored  on  scratch  tape. 

The  deflection  second  spectral  moments  are  generated  in  TL01  sub¬ 
routine  DSECM2,  section  IV  2.  c.  (2) (o) ,  for  each  cross  mode.  Sub¬ 
routine  ADDMAT  is  used  to  sum  the  deflection  second-spectral-moment 
matrices  over  m  unlike  modes. 

The  real  matrix  calculated  in  step  14  is  added  to  its  transpose  to  form 
the  real  part  of  the  deflection  second-spectral-moment  matrix.  The 
imaginary  part  of  the  matrix  calculated  in  step  14  is  added  to  its  negative 
transpose  to  form  the  real  part  of  the  deflection  second-spectral- 
moment  matrix.  This  is  done  in  subroutine  SUMT. 

The  summation  of  the  deflection  second-spectral-moment  matrix 
results  from  contributions  from  both  like  and  unlike  modes  for  the 
real  and  imaginary  parts  as  done  in  subroutine  SUM2. 

The  calculation  of  the  stress  second-spectral-moment  matrix  for  real 
and  imaginary  parts  is  done  in  TL01  subroutine  SSECM2.  See 
section  IV  2.  c.  (2) (p) . 

(b)  Segment  2 — Cross-PSD  Solution 

Excitation  co-PSD  and  quad- PSD  matrices  are  generated  in  subroutine 
RANLOD  for  each  frequency.  The  option  3  excitation  co-PSD  matrices 
are  also  calculated  for  each  frequency.  The  NF  selected  frequencies 
are  card  input. 
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Step  2: 

Step  3: 

Step  4: 

Step  5: 

Step  6: 

Step  7: 

Step  8: 

Step  9: 

Step  10 


The  admittance  scalars  are  calculated  in  subroutine  ADMIT3  for  each 
frequency.  See  section  IV  2.  d.  (2)(e). 

The  like-mode  contributions  to  the  deflection  cross-PSD  matrix 
solutions  are  generated  in  TL01  subroutine  CPSD3.  See  section  IV 
2.  d.  (2)(i). 

The  like-mode  contributions  to  the  deflection  cross-PSD  matrix  solu¬ 
tions  calculated  in  step  3  are  summed  in  subroutine  ADDMAT  over 
m  normal  modes  for  each  NF  frequency. 

The  admittance  scalars  are  calculated  in  subroutine  ADMIT2,  section 
IV  2.c.  (2)  (j),  for  each  frequency.  If  a  parameter  K  is  specified, 
there  are  K  cross-product  scalars  formed  at  each  mode  for 
each  frequency. 

In  subroutine  CQCPSD,  section  IV  2.c.(2)(k),  the  excitations  calculated 
in  step  1  are  combined  with  the  admittance  scalars  calculated  in  step  5 
for  each  frequency,  and  the  resultant  matrices  are  stored  on  scratch 
tape. 

A  component  of  each  of  the  deflection  co-  and  quad- PSD  matrices  is 
calculated  at  each  mode  for  NF  frequencies  in  TL01  subroutine  CPSD2. 

See  section  IV  2.  c.  (2)(q).  The  ADDMAT  subroutine  is  used  to  sum  the 
cross-modal  matrices  for  each  mode  at  NF  frequencies. 

The  component  co-PSD  matrix  calculated  in  step  7  is  added  to  its  trans¬ 
pose  to  form  the  deflection  co-PSD  matrix.  The  component  quad-PSD 
matrix  calculated  in  step  7  is  added  to  its  negative  transpose  to  form  the 
deflection  quad-PSD  matrix.  There  are  NF  co-  and  quad-PSD  solutions 
for  cross -modal  contributions.  This  is  done  in  subroutine  SUMT. 

Subroutine  SUM3  sums  matrices  obtained  in  steps  4  and  8  to  obtain 
the  deflection  cross-PSD  matrices. 

The  stress  cross  PSD  is  generated  in  TL01  subroutine  SRESP2.  See 
section  IV  2.  c.  (2)(v). 
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(2)  Subroutine  Descriptions 


(a)  Subroutine  RANLOD  (Refer  to  section  IV  1. ) 

(b)  Subroutines  ADMIN3,  ADDMAT,  DJNT3,  ADMIT3,  and 
CPSD3  (See  the  subroutine  descriptions  for  option  3,  section 
IV  2.  d.  (2).) 

(c)  Subroutine  ADMIN2 

This  subroutine  (figure  53)  calculates  and  stores  on  tape  the  admittance 
integral  scalars  used  in  the  calculation  of  deflection  covariance. 

Method:  The  admittance  integral  scalars 


Input: 

Output: 

Error: 


and 


/*  oo  /»  oo 

/  D.  E.  dcu,  /  D.  E.  dcu 

Jo  1  1  Jo  J  1 

f  (D.  D.  +  E.  E.)  dcu 

Jo  1  j  1  y 


dcu 


dcu 


'0 

are  combined  in  the  following  manner: 

/OO  OO 

D.  E.  dcu-  /  D.  E. 

1  3  Jq  J  i 

Xoo  /*  °° 

D.  E.  dcu-  /  D.  E. 

3  1  J0  1  3 

DDEE..  =  f  (D  D.  +  E.  E.)  dcu 

i]  J0  i  3  1  3 

where:  i  =  1,  m  -  1 

j  =  i  +  1,  i  +  K  <  m 

See  the  Engineering  User’s  Guide, 
reference  3,  for  definitions  of  the  integrals. 

Mode  shapes  from  phase  I  output  tape 

Admittance  integral  scalars  are  stored  on  tape. 

READTP/WRTETP  error  messages 


Subroutines  required:  READTP/WRTETP,  SCALE 
Length:  15301g 
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ENTER 


16 


16 


16 


12 


Figure  53.  ADMIN2  Flow  Chart 
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(d)  Subroutine  SCALE 

This  subroutine  (figure  54)  examines  the  magnitude  of  the  first  natural 
frequency  and  then  uses  an  appropriate  factor  to  scale  frequencies. 


Method: 

This  subroutine  will  only  scale  frequencies  co  from  0 
to  100,000  Hz.  If  0  <  co  <  100 

100  <  co  <  1,  000 

1,  000  <  co  <  10,  000 

10,  000  <  co  <  100,000 

the  scale  factors  are 

10 

100 

1,000 

10,000  respectively. 

Input: 

Frequencies  and  m 

Output: 

Scale  factor  and  the  scaled  frequencies 

Argument  list: 

FREQ  =  frequencies 

M  =  number  of  mode  shapes 

SCAL  =  scale  factor 

Length: 

1058 
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Figure  54.  SCALE  Flow  Chart 
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(e)  Subroutine  CQJD 

This  subroutine  (figure  55)  combines  the  excitation  co-power  [Cp(cu)l  and 
quad-power  IQf(w)1  spectral  density  matrices  and  the  admittance  integral 
scalars  when  calculating  the  deflection  covariance. 

Method:  A  component  of  the  deflection  co-PSD  is 


Input: 

[ CQ 1  ij  =  0Tj  [CfV  "ij  [Qrlij 

A  component  of  the  deflection  quad-PSD  is 

[CQ'ly-  -  I CF  ]t.  +  [Q^ 

/*  oo 

where:  a..  =  /  (D.  D.  +  E.  E.)  dcu 

ij  ;0  1  3  1  3 

p  oo  p  oo 

y..  =  1  D.  E.  d u>  -  /  D.  E.  do; 

L3  Jq  1  3  Jq  3  1 

i  =  1,  m  -  1 

j  =  i  +  1,  i  +  K 

Admittance  integral  scalars  and  the  excitation  co-  and 

quad-PSD  matrices  from  tape 

Output: 

The  ( CQ and  [CQ']^  matrices  are  outputs  on  tape 

Error: 

READTP/WRTETP  error  messages 

Subroutines  required:  READTP/WRTETP 
Length:  40300g 
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ENTER 


Figure  55.  CQJD  Flow  Chart 


(f)  Subroutine  SUMT 

This  subroutine  (figure  56)  sums  a  matrix  with  its  transpose  matrix. 


Method: 

A  matrix  [A]  is  read  from  tape.  The  transpose  of  this 
matrix  is  added  to  itself,  and  the  resultant  matrix  is 

the  real  part  of  the  deflection  covariance.  To  form  the 
corresponding  imaginary  part,  the  transpose  of  this 

matrix  is  subtracted  from  itself.  For  the  deflection 

cross-PSD  calculations,  this  operation  is  repeated  NF 

times,  one  for  each  frequency.  For  the  real  part, 

[A]  +  [A]T 

and  for  the  imaginary  part, 

[A]  -  [A1t 

Input: 

Tape  input  of  matrices 

Output: 

Tape  output  of  the  final  deflection  covariance  or  cross- 

PSD  matrices 

Error: 

READTP/WRTETP  error  messages 

Subroutines  required:  READTP/WRTETP 
Length:  40247g 
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Figure  56.  SUMT  Flow  Chart 
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(g)  Subroutine  SUM2 

Method:  This  subroutine  (figure  57)  sums  contributions  to  the  real 

part  of  the  deflection  covariance  matrix  from  like 

and  unlike  modes.  The  result  is  stored  on  an  output  tape. 

The  imaginary  part  of  the  deflection  covariance  matrix 
is  transferred  from  its  input  tape  to  the  output  tape. 
Contributions  come  from  only  the  unlike  modes. 

Input:  Deflection  covariance  matrices  for  like  modes  stored  on 

ITP1 

Output:  The  deflection  covariance  matrices  including  contributions 

from  like  and  unlike  modes.  This  is  stored  on  tape  ITP1. 

Error:  READTP/WRTETP  error  messages 

Subroutines  required:  READTP/WRTETP 

Argument  list:  ITP1 — Option  3  like-mode  contributions  to  the  deflection 

covariance  matrices  are  stored  on  tape  ITP1. 

ITP2 — Option  2  unlike-mode  contributions  to  the 

deflection  covariance  matrices  (real  and  imaginary  parts) 

are  stored  on  tape  ITP2. 

NO — If  NO  =  1,  then  calculate  option  3 
If  NO  =  2,  then  calculate  option  2 

NCN — If  NCN  =  1,  then  sum  the  deflection  covariance 
matrices 

If  NCN  =  2,  then  sum  the  deflection  second  spectral 
moment  matrices 


Length:  40370g 
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Figure  5  7.  SUM 2  Flow  Chart 
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(h)  Subroutine  SEC  M3 

This  subroutine  (figure  58)  calculates  the  admittance  integral  scalars  used 
in  the  deflection  second  spectral  moments.  The  subroutine  also  reads  mode  shapes 
from  the  phase  I  output  tape  and  restores  them  on  another  tape. 

Method:  [m^2]  =  ) 

..  2 

where:  p^  =  p  +  a<a  +go)^ 
i  =  1,  m 

Input:  Mode  shapes  {0.}  come  from  phase  I  output  tape. 

Output:  A  parameter  matrix,  admittance  integral  scalars,  and 

modes  stored  on  tape. 

Error:  READTP/WRTETP  error  messages 

Subroutines  required:  READTP/WRTETP 
Length:  5423g 
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Figure  58.  SECM3  Flow  Chart 
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(i)  Subroutine  SEC  M2 


The  second-spectral-moment  scalars  for  option  2  deflection  covariance  are 
calculated  in  subroutine  SECM2  in  the  same  manner  as  in  subroutine  ADMIN2, 
section  IV  2.  c.  (2)(c). 

(j)  Subroutine  ADMIT2 

This  subroutine  (figure  59)  calculates  the  admittance  scalars  used  in  the 
formation  of  cross  PSD.  The  cross-modal  constants  and  mode  shapes  are 


stored  on  tape. 

Method: 

The  admittance  scalars  are  combined  in  the  following 

manner: 

DDEE. .  =  D.  D.  +  E.  E. 

U  i  J  i  1 

DE..  =  D.  E.  -  D.  E. 

D  i  1  1  i 

ED..  =  D.  E.  -  D.  E. 

1J  Jill 

Input: 

where:  i  =  1,  m  -  1 

j  =  i  +  1,  i  +  K 

See  the  Engineering  User’s  Guide, 
reference  3,  for  a  definition  of  D^  and  E^  . 

Modes  shapes  from  phase  I  output  tape 

Output: 

Admittance  scalars  on  tape 

Error: 

Standard  READTP/WRTETP  error  messages 

Subroutines  required:  READTP/WRTETP 
Length:  145  6  6g 
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ENTER 


16 


16 


16 


12 


Figure  59.  ADMIT2  Flow  Chart 
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(k)  Subroutine  CQCPSD 


This  subroutine  (figure  60)  combines  the  excitation  matrices  and  the 
admittance  scalars  for  the  real  part  and  imaginary  part  in  generating  the 
cross-PSD  matrices. 


Method:  For  the  real  part, 

lCQ]ij  '“u  Icf].j  [Of].. 

For  the  imaginary  part, 

[ct3V-vij  IcfL  +  “u 

1J  1J 

where:  a..  =  D.  D.  +  E.  E. 

iJ  i  ]  i  J 

y..  =  D.  E.  -  D.  E. 

IJ  1  J  J  i 

i  =  1,  m  -  1 

j  =  i  +  1,  i  +  K 

Input:  Admittance  scalars  and  the  excitation  co-  and  quad-PSD 

matrices  from  tapes 


Output: 


The  resultant  matrices  are  stored  on  tape. 


Error:  Standard  READTP/WRTETP  error  messages 


Subroutines  required:  READTP/WRTETP 
Length:  15155g 


Figure  60.  CQCPSD  Flow  Chart 
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(1)  Subroutine  SUM3 

Method:  This  subroutine  (figure  61)  sums  to  obtain  the  deflection 

co-PSD  matrices  from  like  and  unlike  modal  contributions. 

The  deflection  quad-PSD  matrices  are  transferred  from 
an  input  tape  to  an  output  tape. 

Input:  Cross-PSD  matrices  for  like  and  unlike  modes  are  stored 

on  ITP1  and  ITP2 

Output:  Deflection  cross-PSD  matrices  for  NF  frequencies  are 

stored  on  ITP3 

Error:  READTP/WRTETP  error  messages 

Subroutines  required:  READTP/WRTETP 

Argument  list:  ITP1 — Option  3  deflection  cross-PSD  matrices  (like 

modal  contributions)  are  stored  on  this  tape. 

ITP2 — Cross-PSD  matrices  (contributions  from  unlike 
modes  only)  are  stored  on  this  tape. 

ITP3 — Output  tape  of  summation  of  all  deflection  cross- 
PSD  matrices  for  NF  frequencies. 

Length:  40343g 


Figure  61.  SUM 3  Flow  Chart 
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(m)  TL01  Subroutine  DJNT2 


This  subroutine  (figure  62)  calculates  the  deflection  covariance  matrices. 


INPUT  TAPE  STORAGE 

OUTPUT  TAPE  STORAGE 

TAPE  16:  PARAMETER,  KPARAM,  MODE  SHAPES 
TAPE  15:  EXCITATIONS  CROSS-PSD  MATRICES 

TAPE  8: 

A  6r  wi  +  w  i+l" 

(i  =  1,  m-1 ) 

Figure  62.  DJNT2  Flow  Chart 
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(n)  TL01  Subroutine  SJNT2 


This  subroutine  (figure  63)  calculates  the  joint  stress  [agat]  • 


Figure  63.  SJNT2  Flow  Chart 
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(o)  TL01  Subroutine  DSECM2 

This  subroutine  (figure  64)  calculates  the  deflection  second  spectral  moments. 


INPUT  TAPE  STORAGE  OUTPUT  TAPE  STORAGE 


Figure  64.  DSECM2  Flow  Chart 
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(p)  TL01  Subroutine  SSECM2 


This  subroutine  (figure  65)  calculates  the  joint  stress  second  spectral 
moments. 


INPUT  TAPE  STORAGE  OUTPUT  TAPE  STORAGE 


Figure  65.  SSECM2  Flow  Chart 
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(q)  TL01  Subroutine  CPSD2 

This  subroutine  (figure  66)  calculates  the  cross  modal  contributions  to  the 
deflection  cross-PSD  matrices  at  NF  frequencies 


INPUT  TAPE  STORAGE  OUTPUT  TAPE  STORAGE 


Figure  66.  CPSD2  Flow  Chart 
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(r)  TL01  Subroutine  SRESP2 


This  subroutine  (figure  67)  calculates  the  stress  cross-PSD  matrices  for 
NF  frequencies. 


INPUT  TAPE  STORAGE 


OUTPUT  TAPE  STORAGE 


TAPE  8: 

PARAMETERS  DEFLECTION 

CROSS-PSD  MATRICES 

TAPE  10: 

STRESSES 

TAPE  15:  STRESS 

CROSS-PSD  MATRICES 


PARAMETER  {p} 

' 

' 

STRESS  [S] 

' 

' 

CROSS  PSD  [fcg  (w)] 

' 

[Sj[*6(w)] 

’ 

' 

(  t  ) 

[S]T 

© 


Figure  6  7.  SRESP2  Flow  Chart 
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d.  Option  3  Solution  Program — Normal  Modes  without  Cross  Terms 
(1)  Organization 

Option  3  is  in  two  segments:  (1)  deflection  covariance  and  (2)  deflection 
cross  PSD.  In  this  option,  all  modal  cross-product  terms  are  omitted.  The 
solutions  for  the  imaginary  parts  are  null.  The  limitations  are  as  follows: 

N  <  90 
m  <  25 
NF  <  90 

(a)  Segment  1 — Deflection  Covariance 

Step  1:  The  excitation  co-PSD  matrices  are  calculated  in  subroutine  RANLOD. 

See  section  IV  1. 

Step  2:  The  admittance  integral  scalars  are  calculated  in  subroutine  ADMIN3. 

See  section  IV  2.  d.  (2)(b). 

Step  3:  The  deflection  covariance  matrix  is  calculated  in  TL01  subroutine  DJNT3. 
See  section  IV  2.  d.  (2)(f).  There  are  m  (number  of  normal  modes) 
deflection  covariance  matrices  stored  on  a  scratch  tape.  Subroutine 
ADDMAT,  section  IV  2.d.  (2)(c),  sums  the  deflection  covariance 
matrices  over  m  normal  modes. 

Step  4:  The  stress  covariance  matrices  are  calculated  in  TL01  subroutine  SJN  1  3, 
section  IV  2.  d.  (2)(g),  using  the  stress  matrices  from  the  phase  I  out¬ 
put  tape  and  the  deflection  covariance  calculated  in  step  3.  The  deflection 
covariance  is  premultiplied  by  the  stress  matrices  and  postmultiplied 
by  the  transpose  of  these  matrices. 

Step  5:  The  deflection  second-spectral-moment  matrices  are  calculated  in 
subroutine  DSECM3.  See  section  IV  2.d.  (2)(d).  The  deflection  co- 

p 

variance  matrices  calculated  in  step  3  are  multiplied  by  w.  and  summed 
over  m  normal  modes. 

Step  6:  The  stress  second  spectral  moments  are  calculated  in  TL01  subroutine 

DSJNT3.  See  section  IV  2.d.  (2)(h).  The  deflection  second-spectral- 

moment  matrices  calculated  in  step  5  are  premultiplied  by  |  S  ]  and 

T 

postmultiplied  by  [  S  ] 
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(b)  Segment  2 — Cross-PSD  Solution 


^teP  The  excitation  cross  PSD’s  are  calculated  in  subroutine  RANLOD, 

section  IV  1,  for  each  frequency.  The  NF  frequencies  are  card  inputs. 

steP  2 :  The  admittance  scalars  are  calculated  in  subroutine  ADMIT3,  section 
IV  2.  d.  (2)(e),  for  each  frequency. 

steP  3:  The  deflection  cross-PSD  solutions  are  calculated  in  TL01  subroutine 
CPSD3.  See  section  IV  2.  d.  (2)(i). 

^teP  The  deflection  cross-PSD  matrices  calculated  in  step  3  are  summed 
in  subroutine  A DDMAT,  section  IV  2.  d.  (2)(c),  over  m  normal 
modes  for  each  of  the  NF  frequencies. 

Step_5:  The  stress  cross-PSD  matrices  are  calculated  in  TL01  subroutine 
SRESP3.  (See  section  IV  2.  d.  (2)(j). )  The  deflection  cross-PSD 
matrices  calculated  in  step  4  are  premultiplied  by  the  stress  matrices 
and  postmultiplied  by  the  transpose  of  these  matrices  for  each  of  the 
NF  frequencies. 

(2)  Subroutine  Descriptions 

(a)  Subroutine  RANLOD  (section  IV  1. ) 
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(b)  Subroutine  ADMIN 3  (figure  68) 

The  admittance  integral  scalars  Di  are  calculated  and  stored  on  tape,  the 
mode  shapes  are  read  from  the  phase  I  output  tape  and  re- stored  on  tape. 


Method: 

D.  .  ./(a  ^  m.2) 

where 

2 

(i.  =  (j  +  lw.  +  g  uk  (i  =  1,  m) 

Input: 

All  inputs  come  from  labeled  common. 

Output: 

The  scalars  and  mode  shapes  are  stored  on  tape. 

Error: 

READTP/WRTETP  error  messages 

Subroutines  required:  READTP/WRTETP 


Argument  list: 

None 

Length: 

5540g 
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ENTER 


Figure  68.  ADMIN3  Flow  Chart 


(c)  Subroutine  ADDMAT 

This  subroutine  (figure  69)  adds  deflection  covariance  or  cross-PSD 
matrices  that  are  stored  on  tape. 


Method: 

The  matrices  that  are  to  be  summed  come  from  a  tape 
(INTAPE).  Each  matrix  is  read  into  the  core,  summed, 

and  stored  on  tape  (OUTAPE). 

Input: 

Matrices  are  input  from  INTAPE. 

Output: 

The  resultant  matrix  is  stored  on  OUTAPE. 

Error: 

Standard  READTP/WRTETP  error  messages 

Subroutines  required:  READTP/WRTETP 


Argument  list: 

INTAPE — Number  of  the  tape  that  contains  the  matrices 

to  be  summed 

OUTAPE  — Number  of  the  tape  that  contains  the  sum¬ 
mation  of  the  matrices  from  INTAPE 

NO — For  the  cross-PSD  calculation,  this  variable  equals 

NF  .  For  deflection  covariance  calculations,  this 

variable  equals  1. 

Length: 

40330g 
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ENTER 


IOUTAPE 


OUTAPE 


Figure  69.  ADDMAT Flow  Chart 


(d)  Subroutine  DSECM3  (figure  70) 


Method: 

The  deflection  covariance  matrices  that  are  calculated  in 

subroutine  DJNT3  are  multiplied  by  the  square  of  the 

frequency  for  each  mode  and  summed  to  form  the  deflec  ¬ 
tion  second  spectral  moments. 

k2]  -  £  |6q  6r|  u,2 

i=l  1  1 1 

Input: 

Deflection  covariance  matrices  are  from  tape. 

Output: 

Deflection  second-spectral-moment  matrix  and  a 

parameter  matrix 

Error: 

Standard  READTP/WRTETP  error  messages 

Subroutine  required: 

READTP/WRTETP 

Argument  list: 

None 

Length: 

40175g 
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Figure  70.  DSECM 3  Flow  Chart 


143 


(e)  Subroutine  ADMIT3  (figure  71) 

Method:  This  subroutine  reads  the  mode  shapes  from  the  phase  I 

output  tape  and  re-stores  them  on  another  tape.  The 
admittance  scalars  are  calculated  and  stored  on  tape. 

D.  =  — 

1 

M. 

i 


/  2  2  \“  2  .  .2 

u  J  + w  (Mj) 

where 

2 

2  gu;i 

Mi  =  M  +  XWi  +__ 

The  admittance  scalars  are  then  squared  and  summed  to 
form  D.^  +  E.^  (i  =  1,  m)  . 


Input:  From  phase  I  output  tape 

Output:  Mode  shapes  and  the  admittance  scalars  for  each  mode 

are  stored  on  tape. 

Error:  Standard  READTP/WRTETP  error  messages 

Subroutines  required:  READTP/WRTETP 
Argument  list:  None 

Length:  6013g 
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ENTER 


' 


Figure  71.  ADMIT 3  Flow  Chart 


(f)  TL01  Subroutine  DJNT3  (figure  72) 
The  deflection  covariance  matrices  are  calculated. 


Figure  72.  DJNT3  Flow  Chart 
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(g)  TL01  Subroutine  SJNT3  (figure  73) 

This  subroutine  calculates  the  stress  covariance  matrix. 


INPUT  TAPE  STORAGE 


TAPE 

3: 

PARAMETER  MATRIX  AND 
DEFLECTION  COVARIANCE 

TAPE 

10: 

STRESS  MATRICES 

OUTPUT  TAPE  STORAGE 


TAPE  15:  STRESS  COVARIANCE 
MATRICES 


Figure  73.  SJNT3  Flow  Chart 
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(h)  TL01  Subroutine  DSJNT3  (figure  74) 


This  subroutine  calculates  the  stress  second-spectral-moment  matrix. 


INPUT  TAPE  STORAGE 

OUTPUT  TAPE  STORAGE 

TAPE  3:  PARAMETER  MATRIX  AND 

TAPE  15:  STRESS  SECOND 

DEFLECTION  SECOND-SPECTRAL- 

SPECTRAL  MOMENT 

MOMENT  MATRICES 

MATRICES 

TAPE  10:  STRESS  MATRICES 

PARAMETERS 


' ' 


DEFLECTION  SECOND 
SPECTRAL  MOMENTS 


STRESSES  [S] 
(8  BY  N)  PLATES 
(6  BY  N)  BEAMS 


•+ 


’ ' 


[S]  [Mg2]  [S] T 


Figure  74.  DSJNT3  Flow  Chart 
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(i)  TL01  Subroutine  CPSD3  (figure  75) 


This  subroutine  calculates  the  deflection  cross-PSD  matrices  at  NF 
frequencies. 


INPUT  TAPE  STORAGE  OUTPUT  TAPE  STORAGE 


TAPE  2:  PARAMETER  MATRIX  AND  SCALARS 

TAPE  8:  m  CROSS-PSD 

TAPE  11:  MODE  SHAPES 

MATRICES  AT  NF 

TAPE  17:  EXCITATIONS  [  CF  (w  )] 

FREQ 
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(j)  TL01  Subroutine  SRESP3  (figure  76) 

The  stress  cross-PSD  matrices  are  calculated  at  NF  frequencies. 


INPUT  TAPE  STORAGE  OUTPUT  TAPE  STORAGE 


Figure  76.  SRESP3  Flow  Chart 
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APPENDIX  I 


TL01  DESCRIPTION  AND  LISTING 


Matrix  interpretive  scheme  TL01  is  written  in  MAP  assembly  language. 
The  program  performs  algebraic  and  manipulative  operations  on  matrices. 


The  TL01  program  instructions  are  executed  from  data  inputs  consisting  of 
one  data  card  for  each  TL01  instruction.  Standard  matrix  storage  is  row-wise 
sequential  as  opposed  to  normal  FORTRAN  order. 

The  required  subroutines  are  as  follows: 


Subroutine 


Function 


KRD 

FSR 

FSF 

BSF 

INV4DS 

DATASB 


Reads  all  card  inputs 
Controls  forward  tape  record  spacing 
Controls  forward  tape  file  spacing 
Controls  backward  tape  file  spacing 
Calculates  the  inverse  of  a  matrix 
Establishes  data  storage 


The  flow  charts  for  the  TL01  program  are  in  figure  77. 


This  appendix  contains  the  following  listings: 


Subroutine  PaSe 

TL01  Listing .  160 

INV4DS .  214 

DATASB .  225 

KRD .  226 

BSF .  233 

FSF .  235 

FSR .  237 
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' ' 


CALLING  SEQUENCE 


TAPE 

=  TAPE  NUMBER  (ADDRESS  OR 

DECREMENT) 

RELOC 

=  RELOCATION  CONSTANT  (ADDRESS 

OR  DECREMENT) 

IRROR 

=  5  CELL  ERROR  CODE. 

Figure  77.  TL01  Flow  Chart 


YTL01 


Figure  77— Continued 


o 


CALLING  SEQUENCE 


CALL 

MMM 


ERROR 
RN 


FIELD  1 
FIELD  2 
FIELD  3 
FIELD  4 
FIELD  5 


SUCCESS 

RETURN 


© 


Figure  77—  Continued 
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Figure  77— Continued 
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ERROR 

RETURN 

COMPUTE  ADDRESS  OF 
POSITION,  AND  PUT  IN 
MMM90  CALLING 
SEQUENCE 


F  )  (  G 

Figure  77— Continued 
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Figure  77-Continued 


Figure  77— Continued 
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Figure  77— Concluded 
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TLOI  LISTING 


SIBMAP 

help 

DECK 

» 

ENTRY 

SUBROUTINE  TO  ACT  AS  TLOIMN 
TLOI 

TLOI 

SXA 

SAVE*#* 

CLA 

3.* 

STA 

SUBR+3 

CLA 

ADRSA 

SUB 

RELOC 1 

ADO* 

*>* 

STO 

RELOC 

CLA 

5  #  * 

STA 

SUBR+5 

SUBR 

CALL 

YTLOl ( 0 • RELOC  # 0 ) 

SAVE* 

AXT 

0#* 

TRA 

6  »  * 

AORSA 

PZE 

DATA 

RELOCI 

PZE 

8000 

reloc 

PZE 

0 

END 
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SIBMAP  YTLOSB  3200 »DECK • M94/2  YTL00000 

* YTL01  ****  YTL01  7094  IBSYS  ASSEMBLY »  AUGUST t  1967  ****  YTLOOOlO 


* 

-00020 

# 

.00030 

* 

YTL00040 

# 

YTL000&0 

* 

YTL00060 

* 

YTL00070 

» 

YTL00080 

* 

SUBROUTINES 

MMM  AND  YTL01 

YTL00090 

* 

YTL00100 

ENTRY 

YTL01 

YTLOOHO 

* 

CALL  YTL01(NTAPE»NSHIFT  * IRROR ) 

YTL001Z0 

* 

DIMENSION  I RROR ( 5 ) 

YTLOOl^O 

* 

CALLING  SEQUENCE  IS  STRICTLY 

YTL00140 

* 

TO  FORTRAN 

CONVENTIONS 

YTLOOIBO 

* 

YTL00160 

ENTRY 

YTL01 

YTL00170 

* 

DUMMY  ENTRY 

TO  ELIMINATE  POSSIBLE  ERRORS 

YTL00180 

* 

YTL00190 

ENTRY 

MMM 

YTL00200 

* 

CALL  MMM { XLOCA  »  XLOCB »  XLOCC » NAM EC  tNCODE ) 

YTL00210 

* 

YTL002Z0 

* 

YTL00230 

* 

THESE  ENTRY 

POINTS  ARE  FOR  DUMP  PURPOSES  ONLY 

YTL00240 

* 

YTL002&0 

* 

YTL00260 

ENTRY 

ERRCDE 

ERROR  CODE 

YTL00270 

ENTRY 

TAPE 

TAPE  INFORMATION 

YTL00280 

# 

YTL00290 

* 

YTL00300 

YTL01 

TTR 

YTL01 

YTL00310 

* 

YTL003-i0 

YTL01 

LMTM 

YTL00330 

EFTM 

YTL00340 

SXD 

XR1»1 

YTL003&0 

SXD 

XR2  « 2 

YTL00360 

SXD 

XR4.4 

YTL00370 

CAL 

8 

YTL00380 

SLW 

TMPFPT 

SAVE  CELL  8  FOR  RESTORE 

YTL00390 

CAL 

FPTTRA 

SET  UP  FOR  FL.  PT.  TRAP 

YTL00400 

SLW 

8 

YTL00410 

STZ 

CELLO 

CLEAR  CELL  FOR  STORING  CELL  0 

YTL00420 

STZ 

ERRCDE 

ZERO  ERROR  CODE 

YTL00430 

CAL 

5  i  4 

YTL00440 

ACL 

=  5 

YTL004B0 

STA 

INS 

YTL00460 

CLA* 

3*4 

TAPE  UNIT 

YTL00470 

SLW 

TAP 

YTL00480 

TZE* 

*+2 

TAP=0 

YTL00490 

CAS 

=  19 

YTL00500 

TRA 

TOBIG 

TAP  GREATER  THAN  22 

YTL00510 

TRA 

*+l 

YTL005Z0 

SUb 

=  6 

YTL00530 

TNZ 

YENT 

YTL00540 

CLA 

=  14 

DO  NOT  ALLOW  A  READ  OF  TAPE  6 

YTL005B0 

STO 

ERRCDE 

YTL00560 
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TRA 

YTER 

TOBIG  CLA 

=  13 

ILLEGAL  TAPE  NO 

TRA 

*— 3 

# 

YENT  CALL 

K.RD  ( LOC  * 

■  0  »  I RROR  *  =  5»“10»1,0»TAP) 

CLA 

IRROR 

TZE 

*  +  4 

ADD 

=  100 

K.RD  READ  CODE 

STO 

ERRCDE 

TRA 

YTER 

AXT 

4,1 

CLA 

LOC 

ADO 

LOC+5,1 

T  IX 

*-1*1*1 

TZE 

YTOUT 

FINISHED 

LXD 

XR  4 , 4 

CLA* 

4,4 

RELOCATION 

TZE 

YTEX 

STO 

# 

YSHIFT 

• 

YTEX  CALL 

MMMtLOC, 

LOC+1 ,L0C+2 , LOC+3, LOC+4 ) YTER 

TRA 

YENT 

NEXT  CARD 

# 

YTOUT  AXT 

5,2 

ST2* 

INS 

CLEAR  ERROR  AREA 

T  I X 

*-1,2*1 

YEXIT  LXD 

XR1 ,1 

LXD 

XR2.2 

LXD 

XR4 ,4 

CAL 

TMPFPT 

RESTORE  CELL  8 

SLW 

8 

TRA 

6,4 

SUCCESS  RETURN 

* 

YTER  NZT 

YSHIFT 

TTR 

YTER3+1 

TRANSFER  ON  NO  RELOCATION 

AXT 

3,1 

YTER2  CLA 

LOC  +  3 ,1 

TZE 

YTER3 

TRANSFER  ON  BLANK  FIELD 

SSP 

SUB 

SMLTAP 

TPL 

YTER3 

TRANSFER  ON  TAPE  NUMBER 

CLA 

LOC+3, 1 

SSP 

SUB 

LOCORE 

TMI 

YTER3 

TRANSFER  ON  POSITION  NUMBER 

CAL 

LOC  +  3 ,1 

SUB 

YSHIFT 

STA 

LOC+3, 1 

ORIGINAL  ADDRESS 

YTER3  T I X 

YTER2 , 1  , 1 

CALL 

.FWRD.  (  .i 

UN06 . , ERRPNT )  PRINT  ERROR 

CLA 

ERRCDE 

TSX 

• FCNV • , 4 

CLA 

INSCNT 

TSX 

.FCNV. ,4 

CALL 

•  FF I L  • 

CAL 

KEY 

TZE 

NOTPRG 

SUB 

YSHIFT 

YT  l-  005  70 
YT  l- 00500 
YTL005VO 
YT1.00600 
YTl-00610 
Y  T  1.00620 
YT  1-006  30 
YTl-00640 
YT1.00650 
YT  1-00660 
YTL-006  7  0 
YU-00600 
YU.00690 
YU-00700 
YTL.00710 
YTL.00720 
YTL-00730 
YTL.00740 
YTL.00750 
YTL.00760 
YTL.00770 
YTL.00780 
YTL.00790 
YTL.00800 
YTL.008  10 
YTL.00820 
YTL.00830 
YTL.00840 
YTL.00850 
YTL00860 
YTL00870 
YTL  008  80 
YTL00890 
YTL  00900 
YTL00910 
YTL  00920 
YTL  00930 
YTL  00940 
YTL  009  50 
YTL  00960 
YTL00970 
YTL  00980 
YTL00990 
YTL01000 
YTL01010 
YTLOIO^O 
YTL01030 
YTLOIO^O 
YTL  0 1050 
YTL  0 1 060 
YTL01070 
YTL01080 
YTL01090 
YT  L  01 1 00 
YTL01U0 
YTL01120 
YTL01130 
YTL01140 
YTL01150 
YTL01160 
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STO 

YMAA 

CLA 

INST 

SUB 

KEY 

XCA 

ZAC 

DVP 

=  6 

STQ 

PHYSCT 

CALL 

.FWRD.  (  *i 

CLA 

PHYSCT 

TSX 

•  FCNV *  *4 

CALL 

•FFIL. 

NOTPRG 

CLA 

LOC 

ADM 

LOC+1 

ADM 

LOC  +  2 

ADM 

LOC+3 

ADM 

LOC+4 

TNZ 

LDERR 

CLA 

MILYN 

STO 

LOC+4 

LDERR 

AXT 

5.1 

AXT 

5,2 

CAL 

LOC+5,1 

SLW* 

INS 

T  I X 

*+1,1.1 

T  I X 

*-3,2,1 

NZT 

KEY 

TRA 

YEXIT 

STZ 

ERRCDE 

STZ 

KEY 

PNTPRG 

CALL 

MMM (YMAA 

TRA 

YEXIT 

GET  PHYSICAL  INSTRUCTION 
IF  ERROR  DURING  CORE  PR06. 


PHYSICAL  COUNT 


FOR  CORE  PROGRAM  ONLY 


PUT  1.000,000.  IN 
WAS  MADE  WHEN  THE 


FIELD  5 
CURRENT 


WHEN  ERROR 
INSTR*  IS  ZERO 


LOAD  CARD  IN  ERROR 


■1»»0»«0»«20>PNTER 


PNTER  CALL  .FWRD« I .UN06 • .CORERR ) 

CLA  errcde 

TSX  .FCNV.,4 

CALL  .FFIL. 

TRA  YEXIT 

* 

REM  MMM  GENERAL  MATRIX  ROUTINE 
REM  CALLING  SEQUENCE 

•  CALL  MMM(LA»LB»LC»NC»CODE)ERRRET 


REM 

REM  CONTROL  PACKAGE 
REM 

MMM  LMTM 
EFTM 

NZT  FIRST 

TRA  REST 

CLA  ADRSDA 

STA  LOCORE 

ADD*  ADRSDA 

SUB  «1 

STA  HICORE 

CLA*  ADRSDA 

STA  MXDATA 

CLA  HICORE 

SUB  *6  3 

STA  HIPROG 

CLA  ADRSDA 

ADD  «1 


YTL0U70 

YTL01180 

YTL01190 

YTL01200 

YTL01210 

YTL01220 

YTL01230 

YTL01240 

YTL01250 

YTL01260 

YTL01270 

YTL012B0 

YTL01290 

YTL01300 

YTL01310 

YTL01320 

YTL01330 

YTL01340 

YTL01350 

YTL01360 

YTL01370 

YTL01380 

YTL01390 

YTL01400 

YTL01410 

YTL01420 

YTL01430 

YTL01440 

YTL01450 

YTL01460 

YTL01470 

YTL01480 

YTL01490 

YTL01500 

YTL01510 

YTL01520 

YTL01530 

YTL01540 

YTL015&0 

YTL01560 

YTL01570 

YTL01580 

YTL01590 

YTL01600 

YTL01610 

YTL01620 

YTL01630 

YTL01640 

YTL01650 

YTL01660 

YTL01670 

YTL01680 

YTL01690 

YTL01700 

YTL01710 

YTL01720 

YTL01730 

YTL01740 

YTL01750 

YTL01760 
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REST 


THIN 

YTA 


YTB 


STA 

*+l 

YTL01770 

CLA 

*# 

LOWEST  ABSOLUTE  CORE  ADO.  REFERENCED 

YTL01780 

STA 

PROGLO 

YTL01790 

STZ 

FIRST 

YTL01800 

SXD 

IR1.1 

YTL01810 

SXD 

IR2.2 

YTL01820 

SXD 

I R3  *  3 

YTL.01830 

SXD 

IR4.4 

YTL01840 

SXD 

IR5#5 

YTL01850 

SXD 

IR6  *6 

YTL01860 

SXD 

IR7  .7 

YTL01870 

STZ 

MCROCT 

COUNT  FOR  ST0RIN6  RETURNS 

YTL.01880 

STZ 

KEY 

YTL018V0 

CLA* 

3*4 

AA 

YTL01900 

TNZ 

*+2 

YTL01910 

SSP 

STO 

LOC 

YTL01920 

YTL01930 

STO 

YMAA 

YT1.01940 

CLA* 

4*4 

YTL.01950 

TNZ 

*+2 

YTL01960 

SSP 

STO 

LOC+1 

YTL.01970 

YTL.01980 

STO 

YMBB 

YTL.01990 

CLA* 

5.4 

CC 

YTL.02000 

TNZ 

*+2 

YTL.02010 

SSP 

STO 

LOC+2 

YTL02020 

YTL02030 

STO 

YMCC 

YTL02040 

CLA* 

6.4 

NAME  OF  C 

YTL02050 

TNZ 

*■►2 

YTL02060 

SSP 

STO 

LOC+3 

YTL.02070 

YTL02080 

STO 

YMNC 

YTL02090 

CLA* 

7.4 

YTL02100 

TNZ 

*  +  2 

YTL02110 

SSP 

STO 

L0C*4 

YTL02120 

YTL02130 

STO 

YMOP 

YTL02140 

AXT 

3,1 

YTL02150 

YTL02160 

NZT 

LOC+3.1 

YTL02170 

TTR 

YTB 

ZERO  FIELD 

YTL02180 

CLA 

LOC+3,1 

YTL02190 

SSP 

SUB 

SMLTAP 

YTL02200 

YTL02210 

TPL 

YTB 

YTL02220 

CLA 

LOCt-3.1 

YTL02230 

SSP 

SUB 

PROGLO 

YTL02240 

YTL02250 

TMI 

YTB 

YTL02260 

CAL 

LOC+3.1 

YTL02270 

ADO 

YSHIFT 

RELOCATE  CORE  ADDRESSES 

YTL02280 

STA 

LOC+3.1 

YTL02290 

STA 

YMAA+3.1 

YTL02300 

T  IX 

YTA.1.1 

YTL023 10 

CLA 

YMOP 

YTL02320 

TNZ 

YMA 

NOT  OPERATION  ZERO 

YTL02330 

CLA 

YMAA 

YTL02340 

TNZ 

YMA 

YTL02350 

CLA 

YMBB 

YTL02360 
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# 

YMA 


YYY 


YMB 


YME 


TMI 

YMA 

YTL02370 

SUB 

SMLTAP 

YTL02380 

TPL 

YMA 

YTL02390 

CLA 

YMBB 

YTL02400 

TZE 

YMEXEC 

YTL02410 

STO 

XMODE 

FIELD  2  IS  A  PARTITION 

YTL02420 

STZ 

PARTON 

ZERO  PARTON  WHEN  A  PARTITION  IS  FORMED 

YTL02430 

TSX 

CHKRNG.4 

CHECK  TO  SEE  IF  NO.  IS 

YTL02440 

TRA 

*+2 

BETWEEN  BOOO  AND  32563 

YTL02450 

TRA 

WHERE 

OK  ON  PARTITION  ADDRESS 

YTL02460 

CLA 

*21 

YTL02470 

TRA 

YMERR 

TOO  LOW  OK  TOO  HI  PARTITION 

YTL02480 

YTL02490 

AXT 

1*1 

YTL02500 

SXA 

TEMP-1 #1 

3  FIELDS 

YTL02510 

CLA 

YMOP 

YTL02520 

SUB 

*19 

YTL02530 

TZE 

YYY 

CODE  19 

YTL02540 

CLA 

YMOP 

YTL02550 

SUB 

*20 

YTL02560 

TZE 

YYY 

CODE  20 

YTL02570 

CLA 

YMOP 

YTL02580 

SUB 

*23 

YTL02590 

TZE 

YYY 

CODE  23 

YTL02600 

AXT 

3.1 

YTL02610 

SXA 

TEMP-1.1 

1  FIELD  FOR  READ 

YTL02620 

YTL02630 

LXA 

TEMP-1.1 

YTL02640 

AXT 

0.2 

YTL02650 

CLA 

XMODE 

YTL02660 

STO 

TEMP 

PARTITION 

YTL02670 

CLA 

YMAA.2 

PARAMETER 

YTL02680 

TMI 

YMC 

YTL02690 

TZE 

YMC 

YTL02700 

SUB 

TOPPOS 

YTL02710 

TPL 

YMC 

NOT  A  POS.  NO. 

YTL027Z0 

CLA 

PARTON 

YTL02730 

TZE 

*+3 

YTL02740 

CLA 

*22 

POSITION  REFERENCED  WITHOUT  PARTITION 

YTL02750 

TRA 

YMERR 

YTL02760 

CLA 

YMAA.2 

YTL02770 

SUB 

*1 

YTL02780 

TZE 

YMD 

position  NO.  IS  ONE 

YTL02790 

PAX 

0.4 

YTL02800 

CAL 

TEMP 

YTL02810 

ADO 

*1 

YTL02820 

SLW 

TEMP-1 

ADDRESS  OF  M 

YTL02830 

ADD 

*1 

YTL02840 

SLW 

TEMP-2 

ADDRESS  OF  N 

YTL02850 

LDO* 

TEMP-1 

YTL02860 

MPY* 

TEMP-2 

YTL02870 

TNZ 

WAYTOB 

YTL02880 

STQ 

XCA 

TEMP-1 

YTL02890 

YTL02900 

TZE 

GOODDM 

YTL02910 

TMI 

«+5 

YTL02920 

CAS 

MXDATA 

YTL02930 

TRA 

*+3 

YTL02940 

TRA 

GOODDM 

YTL02950 

TRA 

GOODDM 

YTL02960 

165 


waytob  stz 

LDQ 

KPY 

STQ 

CLA 

SXA 

S'JB 

ADD 

ADD 

TRA 

GOODDM  CLA 
ACL 
ACL 
SLW 
T  I X 

YMD  CLA 
STO 

YKC  TXI 
CLA 
T  I X 


JEMP-1 
YMAA .2 
THOUSN 
TEMP 
YMAA  .  2 
TEMP-1 .4 
TEMP-1 
TEMP 

=2000000 

YMERR 

TEMP-1 

-3 

TEMP 

TEMP  NEXT  MATRIX 

YME  »  A  *  1 

TEMP 

YMAA. 2  INSERT  ADDRESS 

*+l .2 .-1 

XMODE 

YMB-1.1.1 

SEPARATION  OF  ZERO  OP.  CODES 


YSEP 

CLA 

YMOP 

TNZ 

YMEXEC 

SEPA 

CLA 

YMBB 

SSP 

ADD 

YMCC 

ADM 

YMNC 

TNZ 

SEPC 

CLA 

YMAA 

SUB 

SMLTAP 

TPL 

SEPB 

TTR 

MLOAD 

SEPB 

CLA 

YMAA 

TSX 

TP. 4 

STO 

TAP 

XCA 

TZE 

*  +  3 

CLA 

-13 

TRA 

YMERR 

XCA 

CAS 

-5 

TRA 

*+2 

TRA 

WHERE 

STO 

TAPE 

TSX 

TPCK..4 

TRA 

WHERE 

SEPC 

CLA 

YMBB 

SSP 

ADD 

YMCC 

TNZ 

YMEXEC 

CLA 

YMAA 

TMI 

CYCLE+2 

CAS 

locore 

TRA 

MLOAD 

TRA 

MLOAO 

TRA 

CYCLE 

► 

MLOAD 

CLA 

YMAA 

NOT  OP.  CODE  0 


TRANSFER  OF  CONTROL 
LOAD  PROGRAM 


ALLOW  9 


YTL02970 
YTL02980 
YTL029V0 
YTL03000 
YTL03010 
YTL03020 
YTL03030 
YTL030A0 
YTL030&0 
YTL03060 
YTL03070 
YTL03060 
YTL03090 
YTL03100 
YTL03U0 
YTL03120 
YTL03130 
YTL031A0 
YTL031B0 
YTL03160 
YTL03170 
YTl-03180 
YTL03190 
YTL03200 
YTL03210 
YTL03220 
YTL03230 
YTL03240 
YTL03250 
YTL03260 
YTL03270 
YTL03280 
YTL03290 
YTL03300 
YTL03310 
YTL03320 
YTL03330 
YTL03340 
YTL033B0 
YTL03360 
YTL03370 
YTL03380 
YTL03390 
Y  TL03400 
YTL03410 
YTL03420 
YTL03430 
YTL03440 
VTL03490 
YTL03460 
YTL03470 
YTL03480 
YTL03490 
YTL03?00 
VTL03510 
YTL03520 
YTL03530 
YTL03S40 
YTL03550 
YTL03560 
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CAS 

TRA 

TRA 

CLA 

TRA 

CAS 

TRA 

TRA 

ADO 

STA 

CLA 

STA 

SEPD  CALL 
STO 
CLA 
TZE 
XCA 
MPY 
XCA 
ADD 
ADD 
TRA 

CONTX  CLA 
ADD 
STA 
ADD 
STA 
CLA 

NOINST  STO 
CLA 

ALWYS6  STO 
CLA 
TZE 
STO# 
TRA 
CLA 
STO* 
CLA 
STO 
CLA 
ADD 
STO 
CLA 
STA 
TNZ 
CLA 
STO 
TRA 
CLA 
STO 
TRA 

• 

SEPF  LOO* 
MPY 
XCA 
PAX 
AOD 
STA 
AXT 

GETFLD  CLA 


LOCORE 

PROGRAM  MUST  LOAD  BETWEEN 

YTL03570 

*+4 

ADRSOA  AND  32300* INCLUSIVE 

YTL03580 

*+3 

YTL03590 

-23 

YTL03600 

YMERR 

YTL03610 

HIPROG 

YTL03620 

*-3 

YTL03630 

*+l 

YTL03640 

-3 

YTL03650 

SEPD+3 

YTL03660 

TAP 

YTL03670 

SEPE 

CURRENT  TAPE 

YTL03680 

KRD  ( **  * 

-1 » IRR0R#-5**1Q*-1 *SEPEI 

YTL03690 

TEMP 

CARD  COUNT 

YTL03700 

IRROR 

KRD  ERROR  CODE 

YTL03710 

CONTI 

YTL03720 

YTL03730 

THOUSN 

YTL03740 

YTL03750 

TEMP 

YTL03760 

MILYN 

YTL03770 

YMERR 

YTL03780 

YMAA 

STUFF  ADDRESS  OF  DIMENSION 

YTL03790 

-1 

YTL03800 

NOINST 

ROW.  DIMENSION 

YTL03810 

-1 

YTL03820 

ALWYS6 

YTL03830 

TEMP 

YTL03840 

*# 

YTL03850 

■  6 

YTL03860 

*# 

YTL03870 

YMNC 

YTL03880 

*+3 

YTL03890 

YMAA 

YTL03900 

SEPF 

YTL03910 

THOUSN 

YTL03920 

YMAA 

YTL03930 

SEPD+3 

YTL03940 

INST 

NEXT  INSTRUCTION 

YTL03950 

INSCNT 

YTL03960 

-1 

YTL03970 

INSCNT 

YTL03980 

KEY 

YTL03990 

SAVKEY 

YTL04000 

*+4 

YTL04010 

YMAA 

FROM  CARD  PROGRAM 

YTL04020 

KEY 

YTL04030 

SEPF 

YTL04040 

YMAA 

FROM  CORE  PROGRAM 

YTL04050 

KEY 

YTL04060 

SUBLNK 

STORE  RETURN  LOCATION 

VTL04070 

YTL04080 

NOINST 

YTL04090 

-* 

YTL04100 

YTL04H0 

0*1 

YTL04120 

SEPD+J 

YTL04130 

GETFLD 

YTL04140 

5*2 

YTL04150 

**»1 

YTL04160 
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CYCLE 

NE6CT 


CYAT 

CYA 

CYB 


TNZ 

*+2 

STZ* 

GETFLD 

TXI 

*+l»l»-l 

T  IX 

GETFLD ♦ 2  » 1 

STZ* 

GETFLD 

T  IX 

GETFLD— 1 »1 » 1 

CLA 

YMNC 

TNZ 

WHERE 

STZ 

INSCNT 

TTR 

COREX 

SUB 

THOUSN 

STO 

YMAA 

CLA 

KEY 

TNZ 

*■♦■3 

CLA 

-24 

TRA 

YMERR 

CLA 

YMNC 

TZE 

*+4 

TPL 

*  +  3 

CLA 

-25 

TRA 

YMERR 

STO 

TEMP 

SUB 

PROGLO 

TMI 

CYAT 

CCA 

YMNC 

ADD 

YSHIFT 

STA 

YMNC 

CLA* 

YMNC 

TZE 

*♦2 

TMI 

NEGCT 

STO 

TEMP 

SUB 

THOUSN 

TMI 

CYA 

CLA 

-26 

TRA 

YMERR 

CLA 

YMNC 

SUB 

THOUSN 

TMI 

*♦2 

TRA 

CYAT-2 

CLA 

INST 

SUB 

-1 

STO 

TEMP-1 

CAL* 

TEMP-1 

ANA 

-0077777000000 

TNZ 

CYB 

CLA 

TEMP 

STO* 

TEMP-1 

ALS 

18 

ORS* 

TEMP-1 

CLA* 

TEMP-1 

ANA 

-0000000077777 

TZE 

COUT 

SUB 

-1 

TZE 

COUT 

STA* 

TEMP-1 

CLA 

YMAA 

SUB 

-1 

XCA 

CANNOT  CYCLE  FROM  TAPE 
COUNT 

ZERO  COUNT 


NEGATIVE  COUNT 


ZERO  COUNT 
COUNT  IS  IN  TEMP 

COUNT  MUST  BE  LTE  TO  1000 


ADDRESS  OF  SUB-COUNT 

PRIMED 

PRIME 

PUT  TOTAL  COUNT  IN  DECREMENT 


NEW  SUB-COUNT 


YTL04170 

YTL04180 

YTL04I90 

YTL04200 

YTL04210 

YTL04220 

YTL04230 

YTL04240 

YTL042&0 

YTL04260 

YTL04270 

YTL04280 

YTL04290 

YTL04300 

YTL04310 

YTL04320 

YTL04330 

YTL04340 

YTL043&0 

YTL04360 

YTL04370 

YTL04380 

YTL04390 

YTL04400 

YTL04410 

YTL04420 

YTL04430 

YTL04440 

YTL04450 

YTL04460 

YTL04470 

YTL044B0 

YTL.04490 

YTL04500 

YTL04510 

YTL04520 

YTL04530 

YTL04540 

YTL04550 

YTL04560 

YTL04570 

YTL04580 

YTL04390 

YTL04600 

YTL04610 

YTL04620 

YTL04630 

YTL04640 

YTL046&0 

YTL04660 

YTL04670 

YTL04A80 

YTL04690 

YTL04700 

YTL04710 

YTL04720 

YTL04730 

YTL04740 

YTL04750 

YTL0476Q 


MPY 

*6 

YTL0A770 

XCA 

YTL04780 

ADD 

INST 

YTL04790 

STO 

INST 

NEXT  CARD 

YTL04800 

STO 

SAVINS 

INST,  LOC,  FOR  RETURN  ARRAY 

YTL04810 

TRA 

COUT+1 

YTL04820 

• 

YTL04830 

COUT 

STZ* 

TEMP-1 

YTL04840 

CLA 

INSCNT 

YTL04850 

ADD 

-1 

YTL04860 

STO 

INSCNT 

YTL04870 

TTR 

COREX 

YTL04880 

• 

YTL04890 

COREX 

AXT 

5,1 

YTL04900 

CLA* 

INST 

LOAD  CARD 

YTL04910 

STO 

YMAA+5,1 

YTL04920 

STO 

LOC+5 ,1 

FOR  ERROR  TRACE 

YTL04930 

CAL 

INST 

YTL04940 

ADD 

■1 

YTL04950 

SLW 

INST 

YTL04960 

T  IX 

COR EX* 1 ,1*1 

YTL04970 

CAL 

INST 

YTL04980 

ADD 

■1 

YTL04990 

SLW 

INST 

NEXT  CARD 

YTL05000 

SLW 

SAVINS 

YTL05010 

AXT 

5,1 

YTL05020 

PXD 

0,0 

YTL05030 

ADM 

YMAA+5 , 1 

YTL05040 

T  IX 

*-1,1,1 

YTL05050 

TNZ 

YMIN 

YTL05060 

CLA 

MCROCT 

YTL05070 

TNZ 

*♦3 

YTL050B0 

STZ 

KEY 

YTL05090 

TRA 

WHERE+2 

GO  OUT  OF  CORE  PROGRAM 

YTL05100 

PAC 

0,1 

SET  UP  RETURN  LOCATION 

YTL05H0 

CAL 

RETURN-1,1 

YTL05120 

STA 

INST 

NEXT  INSTRUCTION 

YTL05130 

ARS 

la 

YTL05140 

STA 

XMODE 

PARTITION 

YTL05150 

CAL 

PROLOG— 1 ,1 

PROGRAM  LOCATION 

YTL05160 

STA 

KEY 

YTL05170 

ARS 

IS 

YTL05180 

STA 

INSCNT 

YTL05190 

CAL 

MCROCT 

YTL05200 

SUB 

■1 

YTL05210 

SLW 

MCROCT 

YTL05220 

TRA 

COREX 

YTL05230 

• 

YTL05240 

WHERE 

CLA 

INSCNT 

increment  count  OF 

YTL05250 

ADD 

«1 

INSTRUCTIONS  SUCCESSFULLY 

YTL05260 

STO 

INSCNT 

COMPLETED 

YTL05270 

CLA 

KEY 

YTL05280 

TZE 

YMEXIT 

YTL05290 

TTR 

COREX 

YTL05300 

• 

YTL05310 

YMEXEC 

TSX 

MMM90, A 

YTL05320 

YMAA 

PZE 

YTL05330 

YHBB 

PZE 

YTL05340 

YHCC 

PZE 

YTL05350 

YMNC 

PZE 

YTL05360 

YMOP 

PZE 

TTR 

YMERR 

TTR 

WHERE 

« 

YMEXIT 

LXD 

I  R4  *4 

LXD 

IR2.2 

LXD 

I R  3  •  3 

LXD 

I R 1  *  1 

LXD 

IR5.5 

LXD 

I  R6  *6 

LXD 

IR7.7 

TRA 

9.4 

• 

YMERR 

NZT 

ERRCDE 

STO 

ERRCDE 

LXD 

IR4.4 

TXI 

YMEXIT* 1.4.1 

• 

« 

MMM90 

SXD 

SP0T4.4 

CLA 

1.4 

ADD 

-1 

STA 

MMMA 

ADD 

■1 

STA 

MMMA+2 

ADD 

-1 

STO 

LAI  1 

CLA 

2.4 

ADD 

*1 

STA 

MMMB 

ADD 

*  1 

STA 

MMMB* 2 

ADD 

■1 

STO 

LB11 

CLA 

3.4 

STA 

LOCC 

ADD 

»1 

STA 

LOCMC 

ADD 

»1 

STA 

LOCNC 

ADD 

■1 

STO 

LC11 

STZ 

ANULL 

ST  2 

BNULL 

CLA 

WDMNL 

CAS*  LAI 1 

TRA 

*♦2 

STO 

ANULL 

CAS*  LB11 

TRA 

**2 

STO 

BNULL 

MMMA 

CLA 

0 

STO 

MA 

MMNA 

CLA 

0 

STO 

NA 

MMMB 

CLA 

0 

STO 

MB 

CLA 

0 

STO 

NB 

MMMT 

CLA 

5.4 

SUCCESS 

00  NOT  STORE  CODE  IF  PREVIOUSLY  DONE 
ERROR  RETURN  TO  t.4 

STORE  PARAMETERS 


A  IS  NULL 

B  IS  NULL 
LOC  HA 

LOC  NA 

LOC  MB 

LOC  NB 


YTL05370 

YTL05380 

YTL05390 

YTL05400 

YTL05410 

YTL05420 

YIL05430 

YTL05440 

YTL05450 

YTL05460 

YTL05470 

YTL05480 

YTL05490 

YTL05500 

YTL05510 

YTL05520 

YTL05530 

YTL05540 

YTL055&0 

YTL05560 

YTL05570 

YTL05580 

YTL05590 

YTL05600 

YTL05610 

YTL05620 

YTL05630 

YTL05640 

YTL056&0 

YTL05660 

YTL05670 

YTL05680 

YTL05690 

YTL05700 

YTL05710 

YTL05720 

YTL05730 

YTL05740 

YTL05750 

YTL05760 

YTL05770 

Y  TL05780 
YTL05790 

Y  T  L  05  800 

Y  TL058 10 
YTL05820 
YTL05830 
YTL05840 

Y  TL  05850 
YTL05860 
YTL05870 

Y  TL05880 
YTL05890 

Y  TL05900 
YTL05910 
YTL05920 
YTL05930 
YTL05940 
YTL05950 
YTL05960 
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LYST 

* 

* 

MACRO 


PAX  0*1 
TMI  *+3 

SUB  HI  PROG 

TMI  *+3 

CLA  -20 

TRA  MMME 

TXH  MACRO *1*33 

TRA  LYST  » 1 

TRA  MMM33 

TRA  MMM32 

TRA  MMM31 

TRA  MMM30 

TRA  MMM29 

TRA  MMM28 

TRA  MMM27 

TRA  MMM26 

TRA  MMM2S 

TRA  MMM24 

TRA  MMM23A 

TRA  MMM22 
TRA  MMM21 
TRA  MMM20* 

TRA  MMM19 
TRA  MMM18 
TRA  MMM17 
TRA  MMM16 
TRA  MMM15 
TRA  MMM14 
TRA  MMM13 
TRA  MMM12 
TRA  MMM11 
TRA  MMMIO 
TRA  MMM9 
TRA  MMM8 
TRA  MMM7 
TRA  MMM6 
TRA  MMM5 
TRA  MMM4 
TRA  MMM3 
TRA  MMM2 
TRA  MMM1 
TRA  MMMO 


CODE 

FIELD  5  MUST  BE  POSTIVE  AND 
LESS  THAN  32800 


TXH 

CLA 

TRA 

PXA 

ADD 

STO 

ADD 

STO 

STA 

SUB 

STO 

STA 

CLA 

SUB 

TIE 

CLA 


•♦3»1»TSTMAC 

«20  FIELD  3  MUST  BE  GTE  8000 

MMME 

0.1 

YSHIFT 

YMOP 

-3 

INST 

SEPD+3 

-I 

TEMP- I 
#♦1 

••  N 

■6 
»  +  3 

.6  MUST  HAVE  N-6 


YTL05970 

YTL059B0 

YTL05990 

YTL06000 

YTL06010 

YTL06020 

YTL06030 

YTL06040 

YTL06050 

YTL06060 

YTL06070 

YTL06080 

YTL06090 

YTL06100 

YTL06H0 

YTL06120 

YTL06130 

YTL06140 

YTL06150 

YTL06 160 

YTL06170 

YTL06180 

YTL06190 

YTL062O0 

YTL06210 

YTL06220 

YTL06230 

YTL06240 

YTL06250 

YTL06260 

YTL06270 

YTL06280 

YTL06290 

YTL06300 

YTL063I0 

YTL06320 

YTL06330 

YTL06340 

YTL06350 

YTL06360 

VTL06370 

YTL06380 

YTL06390 

YTL06400 

YTL06410 

YTL06420 

YTL06430 

YTL06440 

YTL06450 

YTL06460 

YTL06470 

YTL06480 

YTL06490 

YTL06500 

YTL06510 

YTL06520 

YTL06530 

YTL06540 

YTL06550 

YTL06560 
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TRA 

MMME 

CAL 

TEMP-1 

SUB 

=  1 

STA 

noinst 

CLA 

KEY 

STA 

SAVKEY 

TNZ 

*  +  4 

CLA 

YMOP 

STO 

KEY 

TRA 

SEPF 

CLA 

YMOP 

STO 

KEY 

CLA 

INSCNT 

AOO 

*  1 

STO 

INSCNT 

SUBLNK 

CLA 

MCROCT 

CAS 

*5 

TRA 

*+3 

TRA 

*♦2 

TRA 

NOTFUL 

LXA 

■4  •  1 

CLA 

PRGLOC+5 • 1 

STO 

PRGL0C*4 • 1 

CLA 

RETURN  +  5  *1 

STO 

RETURN+4 • 1 

T  I X 

*-4*1 « 1 

LAC 

MCROCT  *  1 

TRA 

*+5 

NOTFUL 

CAL 

MCROCT 

AOO 

■1 

SLW 

MCROCT 

PAC 

0*1 

CAL 

SAVINS 

SLW 

RETURN-1 • 1 

CAL 

XMOOE 

ALS 

18 

STD 

RETURN-1 *1 

CLA 

SAVKEY 

SLW 

PRGLOC— 1*1 

CLA 

INSCNT 

ALS 

18 

STD 

PRGLOC-1 *1 

TRA 

SEPF 

• 

• 

MMME 

STO 

ERRCOE 

LXO 

SP0T4*4 

TRA 

6*4 

MMMR 

TSX 

TAST  *4 

LXO 

SP0T4.4 

CLA 

4*4 

LOCC 

STO 

0 

CLA 

MC 

LOCMC 

STO 

0 

CLA 

NC 

LOCNC 

STO 

0 

TRA 

7*4 

• 

TAST 

ZET 

SIGN 

TTR 

TEST2 

CORE  PROGRAM 


CHECK  FOR  FULL  RETURN  BUFFER 


MOVE  RETURN* 1  THRU  RETURN** 
INTO  RETURN  THRU  RETURN* 3 


SAVE  ERROR  CODE 

LOC  C 
LOC  MC 
LOC  NC 


YTL06570 

YTLO650O 

YTL06590 

YTL06600 

YTL06610 

YTL06620 

YTL06630 

YTL066*0 

YTL06650 

YTL06660 

YTL06670 

YTL06680 

YTL066V0 

YTL06700 

YTl-06710 

YTL06720 

YTL06730 

YTL067*0 

YTL067&0 

YTL0676p 

YTL06770 

YTL06780 

YTL06790 

YTL06800 

YTL06810 

YTLO602O 

YTL06830 

YTL06840 

YTL06880 

YTL06860 

YTL06870 

YTL06880 

YTL06890 

YTL06900 

YTL069X0 

Y  TL069Z0 
YTL06930 
YTL069*0 

Y  TL069&0 
YTL06960 
YTL06970 
YTL06980 
YTL06990 
YTL07000 
YTL07010 
YTL07020 
YTL07030 
YTL070*0 
YTL07030 
YTL07080 
YTL07070 
YTL07080 
YTL07090 
YTL07100 
YTL07110 
YTL07120 
YTL07130 
YTL07 1*0 
YTL07150 
VTL07160 
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CLA 

=007777 

STO 

SIGN 

CLA 

hicore 

ADD 

=  1 

STA 

*+2 

CLA 

COREND 

STO 

** 

TTR 

1.4 

CLA* 

TEST2-2 

SUB 

COREND 

TZE 

TEST2-1 

CLA 

=  19 

TRA 

MMME 

REM 

REM 

REM 

REM 

MMMO  CAL 
TNZ 


CORE  LIMIT  EXCEEDED 


PACKAGE  I  MMMO»l*2 

MATRIX  TRANSFER.  MATRIX  ADD.  MATRIX  SUBTRACT 

2.4 

POSIT 


CLA  3.4 

SUB  SMLTAP 

TPL  RITE 
CLA  1.4 

SUB  SMLTAP 

TPL  REDE 
TRA  MOVE 


RITE  NZT 

MA 

TRA 

*  +  5 

NZT 

NA 

TRA 

*  +  3 

TSX 

CKDM1 .4 

LXD 

SP0T4.4 

CLA* 

1.4 

TNZ 

*  +  2 

CLA 

=  0 

STO 

SAVE 

CLA 

MA 

STO 

SAVE+1 

CLA 

NA 

STO 

SAVE+2 

STZ 

TESTC 

SPMTC1- 

0  IF  MATRI 

STZ 

SPMTC1 

STZ 

SAVE+4 

LDO 

MA 

MPY 

NA 

XCA 

PAX 

0.2 

STO 

MTN 

TNZ 

NZRO 

CAL 

SAVE 

ACL 

SAVE+1 

ACL 

SAVE+2 

SLW 

SAVE+3 

TRA 

WID 

NZRO  ADD 

=  3 

PAX 

0.1 

ADD 

1.4 

STA 

GTCSM 

NAME 

M 

N 

IS  NOT  SPARSE. OTHERWISE. SPARSE 


M  *  N 
SAVE  M*N 


M  *  N  +  3 
A  ( 1 . 1  )  +  M  *  N 


YTL07170 

YTL07180 

YTL07190 

YTL07200 

YTL07210 

YTL07220 

YTL07230 

YTL07240 

YTL072&0 

YTL07260 

YTL07270 

YTL07280 

YTL07290 

YTL07300 

YTL07310 

YTL07320 

YTL07330 

YTL07340 

YTL073P0 

YTL07360 

YTL07370 

YTL07380 

YTL07390 

YTL07400 

YTL07410 

YTL07420 

YTL07430 

YTL07440 

YTL07430 

YTL07460 

YTL07470 

YTL07480 

YTL07490 

YTL07500 

YTL07510 

YTL075Z0 

YTL07530 

YTL07540 

Y  TL075 1>0 

YTL075P0 

YTL07570 

YTL07580 

YTL07590 

YTL07600 

YTL07610 

YTL07620 

YTL07630 

YTL07640 

YTL076&0 

YTL07660 

YTL07670 

YTL07680 

YTL07690 

YTL07700 

YTL07710 

YTL07720 

YTL07730 

YTL07740 

YTL07750 

YTL07760 


173 


STA 

SXA 

CKNUL1  CLA* 
SUB 
TZE 

CKNUL2  ZET* 
TRA 
T  I X 

NULLM  CAL 
ACL 
ACL 
ACL 
SLW 
TRA 


# 


getcks  lxa 

CKSP1  CLA* 
TZE 
ANA 
TZE 
T  I X 
LXA 
SXA 


AXT 

SPTST1  CLA* 

TNZ 

TXI 

T  I X 

P  X  A 

STO* 

TRA 

TXH 

5PTST 2  T I X 
TRA 
TXI 
PX  A 
STO* 
T  I X 

• 

SPCKS  PXA 
LXA 

CKSP2  ZET* 

CKSP3  ACL* 
T  IX 
ACL 
LDQ 
STQ 
TRA 

« 

LOCKS  PXA 


WRMAT 

YTL07770 

MNP3  *  1 

YTL07780 

WRMAT 

TEST  FOR  WORD  M-NULL 

YTL07790 

WOMNL 

YTL07800 

NULLM 

WORD  M-NULL  PRESENT 

YTL078 10 

WRMAT 

TEST  FOR  ALL  ZEROS 

YTL07820 

GETCKS 

NON-ZERO  ELEMENT 

YTL07830 

*-2  *2  *  1 

YTL07840 

WDMNL 

FORM  CHECK  SUM  FOR  NULL  MATRIX 

YTL078&0 

SAVE 

YTL07860 

SAVE+1 

YTL07870 

SAVE+2 

YTL07880 

TEST  C 

YTL07890 

STCKS 

YTL07900 

THE  FOLLOWING 

SET  OF  INSTRUCTIONS 

YTL07910 

DETERMINE  IF 

A  MATRIX  IS  SPARSE.  IF 

YTL07920 

THE  MATRIX  IS 

SPARSE,  THE  CHECKSUM  IS 

YTL07930 

CALCULATED  NEGLECTING  NEGATIVE  ZEROS. 

YTL07940 

THE  CONTROL  WORDS  ARE  FORMED  AND  PLACED 

YTL079&0 

IN  THE  MATRIX 

BEFORE  THE  CHECKSUM  IS 

YTL07960 

FORMED.  AFTER 

THE  MATRIX  IS  WRITTEN 

YTL07970 

ON  TAPE.  THE 

CONTROL  WORDS  WILL  BE 

YTL07980 

REMOVED  FROM 

THE  MATRIX. 

YTL07990 

MTN.2 

YTL08000 

WRMAT 

TEST  FOR  SPARSE  MATRIX 

YTL08010 

*+3 

YTL08020 

-0377400000000 

YTL08030 

LOCKS 

MATRIX  NOT  SPARSE 

YTL08040 

*-4  *  2  # 1 

YTL08030 

MTN.2 

YTL08060 

SPMTC1.2 

YTL08070 

YTL08080 

THE  FOLLOWING 

FORMS  THE  CONTROL  WORDS 

YTL08090 

0.1 

FIX  CONTROL  WORD 

YTL08100 

WRMAT 

YTL08U0 

SPTST2-1 

YTL08120 

*+1.1.1 

ADD  1  TO  ZERO  COUNT 

YTL08130 

SPTST1.2.1 

YTL08140 

0.1 

YTL081S0 

WRMAT 

STORE  CONTROL  WO-D 

YTL08160 

SPCKS 

GO  FORM  CHECKSUM 

YTL08170 

SPTST2+2.1.0 

YTL08180 

SPTST1.2.1 

YTL08190 

SPCKS 

GO  FORM  CHECKSUM 

YTL08200 

*+l .2.1 

YTL08210 

0.1 

YTL08220 

WRMAT 

STORE  CONTROL  WORD 

YTL08230 

SPTST 1-1 .2.2 

YTL08240 

YTL082S0 

0.0 

FORM  SPARSE  MATRIX  CK  SUM 

YTL08260 

MNP  3 . 1 

YTL08270 

GTCSM 

YTL08280 

GTCSM 

YTL08290 

*-2.1.1 

Y  TL08300 

SPARSE 

YTL08310 

SPARSE 

YTL08320 

SAVE+4 

YTL08330 

STCKS 

YTL08340 

YTL083S0 

0.0 

YIL08360 
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GTCSM 

ACL 

**»1 

T  I X 

*-1*1*1 

STCKS 

SLW 

SAVE+3 

LXA 

MTN*2 

WID 

CLA 

3*4 

SSP 

TSX 

TP  *  4 

STO 

TAPE 

TSX 

TPCK * 4 

CALL 

•  F VI 0  » ( T APE  * ' 

CALL 

•FWRB* ( TAPEIf 

CALL 

.F6LO. (SAVE.- 

CALL 

•FWLR • 

CALL 

.FWRB. (TAPEK 

NZT 

MTN 

TRA 

M I  NR 

ZET 

SPMTC1 

TRA 

WRSPRS 

ZET 

TESTC 

TRA 

WRNULL 

WRMAT 

CLA 

** « 2 

TSX 

•  FBLT  *  *4 

T  I X 

*-2*2*1 

MI  NR 

CLA 

=  16 

SUB 

MTN 

WRMR 

TMI 

ENDWR 

TZE 

ENDWR 

PAX 

0.2 

ZAC 

TSX 

.FBLT. .4 

T  IX 

*-2.2.1 

TRA 

ENDWR 

• 

WRITE  SPARSE 

WRSPRS 

AXT 

0*1 

CLA* 

WRMAT 

TZE 

SPSZP1 

TSX 

.FBLT. .4 

TXI 

*+1*1.1 

LDQ* 

WRMAT 

PXA 

0.0 

LLS 

9 

TNZ 

*+2 

SPSZ 

STZ* 

WRMAT 

SPSZP1 

T  IX 

WRSPRS+1 *2.1 

SXA 

WDWC.l 

CLA 

=  16 

SUB 

WDWC 

TRA 

WRMR 

WRNULL 

CLA 

WDMNL 

TSX 

•FBLT. .4 

AXT 

15.2 

ZAC 

TSX 

.FBLT. *4 

T  IX 

*-2*2.1 

ENDWR 

CALL 

.FWLR. 

TRA 

DONE 

REDE 

CLA 

1*4 

TSX 

TP. 4 

STO 

TAPE 

TSX 

TPCK. 4 

CHECKSUM  IN  FOURTH  WORD 


GET  TAPE  NUMBER 


>16) 


SPARSE  MATRIX 

NULL  MATRIX 
WRITE  MATRIX 


M*N  LESS  THAN  16*  WRITE  MORE 


MATRIX 


ZERO  ELEMENT*  DO  NOT  WRITE 


STORE  ZERO  OVER  CONTROL  WORD 


M-NULL 


GET  TAPE  NUMBER 


YTL08370 
YTL08380 
YTL08390 
YTL08400 
YTL08410 
YTL08420 
YTL08430 
YTL08440 
YTL08450 
YTL08460 
YTL08470 
YTL08480 
YTL08490 
YTL08500 
YTL08510 
YTL08520 
YTL08530 
YTL08540 
YTL08550 
YTL08560 
YTL08570 
YTL08580 
YTL08590 
YTL08600 
YTL08610 
YTL086Z0 
YTL08630 
YTL08640 
YTL086&0 
YTL08660 
YTL08670 
YTL08680 
YTL08690 
YTL08700 
YTL08710 
YTL08720 
YTL08730 
YTL08740 
YTL08730 
YTL08760 
YTL08770 
YTL08780 
YTL08790 
YTL088O0 
YTL08810 
YTL088^0 
YTL08830 
YTL08840 
YTL088&0 
YTL08860 
YT  L088  7  0 
YTL08880 
YTL08890 
YTL08900 
YTL089 10 
YTL089Z0 
YTL08930 
YTL08940 
YTL089&0 
YTL08960 
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CALL 

•  FVIO • l TAPE  » TAPE  I B ) 

YTL08970 

CALL 

•  FRDB • ( TAPE  I B I 

YTL08980 

CALL 

.FBLI  •  (SAVEt-16 ) 

YT  LO  8990 

CALL 

•  FRLR  » 

YTL09000 

LXD 

SP0T4 , 4 

YTL09010 

CLA 

SAVE  NAME 

YTL09020 

STO* 

3.4 

YTL09030 

NZT 

4,4  IS  CARD  NAME  =  0 

YTL09040 

TRA 

*+5  YES 

YTL09030 

SUB 

4,4  NO 

YTL09060 

TZE 

*  +  3 

YTL09070 

CLA 

=17  NAME  ON  TAPE  DOES  NOT  CHECK  YTL09080 

TRA 

MMME 

YTL09090 

CLA 

SAVE+1  YES 

YTL09100 

STO# 

LOCMC 

YTL09110 

STO 

MC 

YTL091Z0 

LDQ 

SAVE+2 

YTL09130 

STO 

NC 

YTL09140 

STO* 

LOCNC 

YTL091S0 

MPY 

SAVE+1 

YTL09160 

TNZ 

XCA 

DIMOK-2 

YTL09170 

YTL09180 

PAX 

0.1  M  *  N 

YTL09190 

STO 

MTN 

YTL09200 

TZE 

DIMOK 

YTL09210 

TMI 

*  +  2 

YTL09220 

CAS 

MXDATA 

YTL09230 

TRA 

*  +  3 

YTL09240 

TRA 

DIMOK 

YTL092&0 

TRA 

DIMOK 

YTL092P0 

CLA 

=  28 

YTL092  70 

TRA 

MMME 

YTL09280 

DIMOK 

ADD 

=  3 

YTL09290 

PAX 

0,2  M  *  N  +  3 

YTL09300 

ADD 

3,4  A ( 1 , 1 )  +  M  #  N 

YTL09310 

STA 

RDMAT 

YTL09320 

STA 

GTCSM1 

YTL09330 

STA 

F  I  XNM 

YTL09340 

TSX 

CHKCOR  ,4 

YTL093S0 

RZM 

CALL 

•  FRDB • <  TAPE  I B ) 

YTL09360 

CLA 

SAVE+4 

YTL09370 

SUB 

SPARSE 

YTL09380 

TNZ 

CKNUL3 

YTL09390 

# 

STZ 

RSCKSM  SPARSE  MATRIX  CHECKSUM 

YTL09400 

YTL09410 

# 

THE  FOLLOWING  SET  OF  INSTRUCTIONS  READ  A 

YTL09420 

« 

« 

sparse 

MATRIX  and  forms  its  checksum 

YTL09430 

YTL09440 

SPRD 

TSX 

•  FBLT  »  ,  4 

YTL094P0 

STO 

readtp  save  word  from  tape 

YTL09460 

CAL 

READTP 

YTL09470 

ACL 

RSCKSM  ADD  TO  CHECKSUM 

YTL09480 

SLW 

RSCKSM 

YTL09490 

CAL 

READTP 

YTL09500 

ANA 

=0377400000000 

YTL09510 

TZE 

KCW  CONTROL  WORD 

YTL09520 

CLA 

READTP 

YTL09530 

STO# 

RDMAT 

YTL09540 

T  IX 

SPRD, 1*1 

YTL095&0 

RLR1 

CALL 

.FRLR, 

YTL09S60 
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CAL 

RSCKSM 

FORM  CHECKSUM 

ACL 

SPARSE 

ACL 

SAVE 

ACL 

SAVE+1 

ACL 

SAVE+2 

TRA 

RDCKS 

KCW  LXA 

READT  P  *  2 

STORE  ZEROS 

STZ* 

RDMAT 

TXI 

*+l.l»-l 

T  I X 

*-2 *2 , 1 

TXL 

RLR1.1.0 

TRA 

SPRD 

CKNUL3  TSX 

«FBLT  •  #4 

NZT 

MTN 

TRA 

RDMAT  +  2 

STO 

TESTC 

SUB 

WDMNL 

M*NULL 

TNZ 

RDMAT-3 

CALL 

♦  FRLR  • 

TRA 

NULLMR 

MATRIX  IS  NULL 

* 

CLA 

TESTC 

GET  A ( 1  *  1 )  BACK 

TRA 

*  +  2 

TSX 

•FBLT..4 

RDM AT  STO 

**.l 

READ  IN  MATRIX 

T  I X 

*-2*1*1 

CALL 

.FRLR. 

CAL 

SAVE+3 

IS  CHECKSUM  *  0 

TZE 

DONE 

YES.  DONE 

ERA 

*1.0 

IS  CHECKSUM  *  1.0 

TZE 

DONE 

YES.  DONE 

PXA 

0*0 

NO.  COMPARE  CHECKSUMS 

GTCSM1  ACL 

**  *  2 

T  I X 

*-1*2*1 

ROCKS  ERA 

SAVE+3 

TZE 

DONE 

CLA 

*18 

CHECKSUM  ERROR 

TRA 

MMME 

NULLMR  LXA 

MTN*2 

STORE  ZEROS  FOR  NULL  MATRIX 

F I XNM  STZ 

**  *  2 

T  I X 

*-1.2*1 

CAL 

WDMNL 

SLW* 

LC11 

ACL 

SAVE 

FORM  NULL  CHECKSUM 

ACL 

SAVE+1 

ACL 

SAVE+2 

TRA 

RDCKS 

POSIT  STZ 

TAPE+2 

STP 

TAPE+2 

SAVE  SIGN  OF  TAPE  INSTRUCTION 

CLA 

2,4 

SSP 

TSX 

TP. 4 

GET  TAPE  NO.  IN  DECREMENT 

STO 

TAPE 

STO 

TAPE+1 

FILE  IN  ADDRESS.  MATRICES  IN  DEC 

TSX 

TPCK.4 

CALL 

.FVIO. (TAPE 

.TAPEIB) 

CLA 

TAPE+1 

TNZ 

SPACE  1 

IS  TAPE  POSITIONING  REQUESTED 

CLA 

TAPE+2 

TPL 

EOF 

YTL09570 
YTL09580 
YTL09590 
YTL09600 
YTL09610 
YTL09620 
YTL09630 
YTL09640 
YTL09630 
YTL09660 
YTL09670 
YTL096B0 
YTL09690 
YTL09700 
YTL09710 
YTL09720 
YTU09730 
YTL09740 
YTL097&0 
YTL09760 
YTL09770 
YTL097B0 
YTL09790 
YTL09800 
YTL09810 
YTL09820 
YTL09830 
YTL09840 
YTL09650 
YTL098-60 
YTL098  7  0 
YTL09880 
YTL09890 
YTL09900 
YTL09910 
YTL09920 
YTL09930 
YTL09940 
YTL09950 
YTL09960 
YTL09970 
YTL099U0 
YTL09990 
YTL10000 
YTLIOOlO 
YTL10020 
YTL10030 
YTLIOOLO 
YTL100&0 
YTL10060 
YTL10070 
YTL10080 
YTL10090 
YTLIOIOO 
YTLIOHO 
YTL10120 
YTL10130 
YTLIOI^O 
YTLIOIOO 
YTL1-0160 


EOF 

SP ACE 1 


FST 


RCOOLY 


* 

DONE 

* 

TP 


TP1 

TP2 


CALL 

TTR 

CALL 

TTR 

CLA 

TPL 

CAL 

ANA 

SUB 

SLW 

CALL 

CLA 

TZE 

ADD 

TRA 

CAL 

ANA 

TZE 

SLW 

CALL 

CLA 

TZE 

ADD 

TRA 

CAL 

ANA 

TZE 

SLW 

CLA 

ARS 

STO 

CALL 

CLA 

TZE 

ADD 

TRA 


•  FRWT  .( TAPEIB ) 

DONE 

.FEFT. (TAPEIB) 

DONE 
TAPE+2 

PST  FORWARD  SPACING 

TAPE+1 

=0000000077777  LEAVE  ONLY  FILE  COUNT 
=  1 

TAPE+1 

BSF(TAPE+1*TAPE*ERR) 

ERR 

DONE 

THOUSN 

MMME 

TAPE+1 

=0000000077777 

RCDOLY  NO  FILE  SPACING 

TAPE+2 

FSF(TAPE+2*TAPEiERR) 

ERR 

*  +  3 

=2000  FSF  ERROR 

MMME 

TAPE+1 

=0077777000000 

DONE  FILE  SPACE  ONLY 

TAPE+1 
TAPE+1 
18 

TAPE+1 

FSR(TAPE+1*TAPE*ERR) 

ERR 

DONE 

=3000  FSR  ERROR 

MMME 


REWIND 

WRITE  END  OF  FILE 


TSX  T AST  *  A 

LXD  SPOT 4»4 
TRA  7*4 


SXD 

AXT 

SUB 

TMI 

TXI 

TNZ 

LDQ 

PXA 

LXD 

TTR 

STZ 

SXA 

ADD 

AXT 

SUB 

TMI 

TXI 


interpret  tape  number 


TEMP. 1 

0.1 

SMLTAP 

TP2 

*+1.1*1 
*-3 
=  0 
0.1 

TEMP . 1 
1.4 

TEMP-1 

TEMP-1.1 

MILYN 

0.1 

THOUSN 

TP4 

*+1.1*1 


SAVE  INDEX 


TRANSFER  IF  BST  OR  FST 
COUNTER 

CLEAR  MO  IFONLY  A  TAPE  NUMBER 
TAPE  NUMBER  IN  AC ( ADDRESS ) 
LOAD  INDEX 
RETURN 

SAVE  TAPE  NUMBER 


TRANSFER  IF  FST 
COUNTER 


YTL10170 
YTL10180 
YTL10190 
YTL 1 0200 
YTL10210 
YTL10220 
YTL10230 
YTL10240 
YTL102i>0 
YTL10260 
YTL10270 
Y  T  L 102  80 
YTL10290 
YTL10300 
YTL10310 
YTL10320 
YTL10330 
YTL  10340 
YTL103&0 
YTL10360 
YTL 103  70 
YTL10380 
YTL10390 
YTL10400 
YTL10410 
YT  L 10420 
YTL 10430 
YTL 10440 
YTL104&0 
YTL10460 
YTL10470 
YTL10480 
YTL  10490 
YTL  1 0  500 
YTL10510 
YTL10520 
YT  L 1 0530 
YTL10540 
YTL105&0 
YTL 10560 
YTL10570 
YTL10580 
YT  L 1 0590 
YTL 10600 
YTL10610 
YTL 10620 
YTL10630 
YTL10640 
YTL  106  50 
YTL 10660 
YTL 10670 
YTL 1 0680 
YTL10690 
YTL 1 0700 
YTL10710 
YTL 107  20 
YTL10730 
YTL10740 
YTL10750 
YTL 10760 
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TNZ 

*-3 

PXD 

0.0 

XCA 

PXA 

0.1 

XCA 

TP3 

CLA 

TEMP-1 

TTR 

TP  1 

TP4 

STZ 

TEMP-2 

SXA 

TEMP-2 

ADD 

THOUSN 

ALS 

19 

STD 

TEMP-2 

LDQ 

TEMP-2 

TTR 

TP3 

* 

• 

CHECK  ' 

• 

TPCK 

LXA 

TAPE  *  1 

TXL 

*  +  3.1  .1 

CLA 

=  13 

TRA 

MMME 

TTR 

tpcko.; 

TPCK19 

TTR 

1.4 

TPCK18 

TTR 

1.4 

TPCK17 

TTR 

1.4 

TPCK16 

TTR 

1.4 

TPCK15 

TTR 

1.4 

TPCK14 

TTR 

1.4 

TPCK13 

TTR 

1.4 

TPCK12 

TTR 

1.4 

TPCK11 

TTR 

1.4 

TPCK10 

TTR 

1.4 

TPCK9 

TTR 

1.4 

TPCK8 

TTR 

1.4 

TPCK7 

TTR 

MMMTP 

TPCK6 

TTR 

MMMTP 

TPCK5 

TTR 

MMMTP 

TPCK4 

TTR 

1*4 

TPCK3 

TTR 

1.4 

TPCK2 

TTR 

1.4 

TPCK  1 

TTR 

1.4 

TPCKO 

TRA 

TPCK+2 

MMMTP 

CLA 

=  14 

TRA 

MMME 

* 

* 

THIS  R' 

• 

DIMENS 

* 

M  *  N 

• 

CKDM1  LDQ 
MPY 
TNZ 
XCA 
TZE 
TMI 
CAS 
TRA 
TRA 
TRA 

CKDM2  LDQ 


CLEAR  MQ  AND  AC 

NO.  OF  FILES  IN  AC { ADDRESS ) 
NOW  IN  MO 
TAPE  NUMBER 


SAVE  NO.  OF  FILES 

2*NO.  OF  RECDS  IN  DECREMENT 

FILES  IN  ADDR#  RECDS  IN  DECRE. 


MA 

NA 

3ADDM1 

BADDM1 

BADDM1 

MXDATA 

BADDM1 

1.4 

1*4 

MB 


STACKED  PUNCH  OUTPUT 
STACKED  OUTPUT 
STACKED  INPUT  ONLY 


LEGAL  TAPE.  BUT  NOT  accessible 


FIELD  1  OR  2.  OR  BOTH 

LESS  THAN  24561  .  NON-ZERO.  AND  POSITIVE 
FIELD  1  CHECK 


FIELD  2  CHECK 


YTL10770 
YTL10780 
YTL10790 
YTL10800 
YTL10810 
YTL10820 
YTL10830 
YTL10840 
YTL10850 
YTL10860 
YTL10870 
YTL10880 
YTL10890 
YTL10900 
YT  L 109 10 
YTL109Z0 
YTL10930 
YTL10940 
YTL109P0 
YTL10960 
Y  TL 10970 
YTL10980 
YTL10990 
YTL11000 

ytluoio 

YTL11020 

YTL11030 

YTL11040 

YTL110&0 

YTL11060 

YTL11070 

YTL11080 

YTL11090 

YTL11100 

YTL11U0 

YTL11120 

YTL1U30 

YTL11140 

YTL11150 

YTL11160 

YTL11170 

YTL11180 

YTL11190 

YTL11200 

YTL11210 

YTL11220 

YTL11230 

YTL11240 

YTL112&0 

YTL11260 

YTL11270 

YTL11280 

YTL11290 

YTL11300 

YTL11310 

YTL11320 

YTL11330 

YTL11340 

YTL11330 

YTL1136Q 
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MPY 

NB 

TNZ 

BADDM2 

XCA 

TZE 

3ADDM2 

TMI 

BADDM2 

CAS 

MXDATA 

TRA 

BADDM2 

TRA 

1*4 

TRA 

1*4 

CKDM12 

SXA 

CKDMRT  *4 

CHECK  BOTH  FIELDS 

TSX 

CKDM1 *4 

TSX 

CKDM2  *  4 

CKDMRT 

AXT 

**  *4 

TRA 

1  *4 

BADDK1 

CLA 

=  3 

TRA 

MMME 

BADDM2 

CLA 

=  4 

TRA 

MMME 

* 

# 

CHECIC  to 

SEE 

IF  A  DIAGONAL  MATRIX 

* 

IS  A  1  X 

N  OR 

A  M  X  1 

CKDG1 

CLA 

=  1 

CAS 

MA 

TRA 

BADDM1 

TRA 

1*4 

CAS 

NA 

TRA 

BADDM1 

TRA 

1.4 

NOTDG 

CLA 

=  5 

TRA 

MMME 

CKDG2 

CLA 

=  1 

CAS 

MB 

TRA 

BADDM2 

TRA 

1.4 

CAS 

NB 

TRA 

BADDM2 

TRA 

1*4 

TRA 

NOTDG 

• 

CHECK  TO 

SEE 

IF  RESULT  MATRIX  WILL  OVERFLOW  CORE 

CHKCOR 

LDQ 

MC 

MPY 

NC 

XCA 

ADO 

LC11 

CAS 

HICORE 

TRA 

OVER 

TRA 

1.4 

TRA 

1*4 

OVER 

CLA 

=  19 

TRA 

MMME 

# 

CHECK  TO 

SEE 

IF  AN  ADDRESS  IS  BETWEEN 

• 

8000  AND 

32563. INCLUSIVE 

CHKRNG 

CAS 

HICORE 

THE  RETURN  IS  MADE  As 

TRA 

1.4 

WITH  A  CAS  INSTRUCTION 

TRA 

2.4 

ABOVE  -  1.4 

CAS 

LOCORE 

INBETWEEN  -  2.4 

TRA 

2.4 

BELOW  -  3.4 

TRA 

2.4 

TRA 

3.4 

* 


YTLU370 

YTL113B0 

YTU11390 

YTLU400 

YTL11410 

YTL 1 1420 

YTL11430 

YTL11440 

YTL114&0 

YTL11460 

YTL 1 1470 

YTL11480 

YTL 1 1490 

YTL 1 1 500 

YTL  1 15  10 

YTL 1 1 5  40 

YTL 1 1 5  30 

YTL  1 1540 

YTL115t>0 

YTL 1 1580 

YTL11570 

YTL 1 1580 

YTL11590 

YTL 1 1600 

YTL11610 

YTL 1 1640 

YTL11630 

YTL11690 

YTL11680 

YTL  1 1680 

YTL11670 

YTL11680 

YTL11690 

YTL 1 1700 

YTL11710 

YTL 1 1720 

YTL11730 

YTL11740 

YTL11730 

YTL11780 

YTL11770 

YTL117O0 

YTL 1 1790 

YTL11800 

YTL11810 

YTL 1 1820 

YTL 11830 

YTL11840 

YTL11850 

YTL 1 I860 

YTL11870 

YTL 1 1880 

YTL11890 

YTL11900 

YTL11910 

YTL11920 

YTL11930 

YTL 1 1940 

YTL 1 1930 

YTL 1 I960 
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» 

FLOATING  POINT  TRAP  ANALYSIS  FOR  ALL 

YTL11970 

» 

OF  THE  OPERATION  CODES 

YTL11980 

* 

YTL11990 

FPSPIL 

STO 

TEMPAC 

YTL12000 

STQ 

TEMPMQ 

YTL12010 

cla 

0 

YTL120Z0 

STO 

CELLO 

YT  L 120-50 

cla 

CELLO 

YTL120A0 

CAS 

=  3B17 

YTL120&0 

TRA 

TSTDIV 

NOT  UNDERFLOW  FROM  MPY,  ADD 

YTL12060 

TRA 

ACMQUF 

UNDERFLOW  IN  BOTH  AC  AND  MQ 

YTL12070 

CLA 

TEMPAC 

UNDERFLOW  IN  MQ  ONLY 

YTL12060 

LDQ 

=  0 

YTL12090 

STZ 

CELLO 

CLEAR  CELL  IF  UNDERFLOW 

YTL12100 

TRA* 

0 

YTL12H0 

ACMQUF 

PXA 

0.0 

CLEAR  AC 

YTL12120 

TRA 

*-4 

YTL12130 

TSTDIV 

CAS 

=  9617 

YTL12140 

TRA 

*  +  4 

IT  IS  A  DIVIDE.  TEST  FURTHER 

YTL121S0 

TRA 

ACMQUF 

MQ  UNDERFLOW  ON  DIVIDE 

YTL12160 

CLA 

=  8 

OVERFLOW  ON  MPY  OR  ADD 

YTL12170 

TRA 

MMME 

YTL12180 

CAS 

*11617 

YTL 1 2 1 90 

TRA 

POSSTO 

OVERFLOW  ON  DIVIDE  OR  IT 

YTL12200 

* 

COULD  ALSO  BE  DOUBLE  PRECISION 

YTL12210 

* 

STORAGE  TRAP 

YTL 12220 

TRA 

ACMQUF 

AC.MQ  UNDERFLOW  ON  DIVIDE 

YTL  12230 

PXA 

0.0 

AC  UNDERFLOW  ONLY 

YTL12240 

LDQ 

TEMPMQ 

YTL12250 

TRA 

ACMQUF-2 

YTL12260 

POSSTO 

CAS 

=  13B17 

YTL12270 

TRA 

*  +  4 

YTL12280 

TRA 

*+l 

YTL12290 

CLA 

=  9 

YTL 12300 

TRA 

MMME 

DIVIDE  OVERFLOW 

YTL  123  10 

CLA 

=  27 

YTL12320 

TRA 

MMME 

D.P.  STORAGE  TRAP. 

YTL 12  330 

# 

THE  FOLLOWING 

ARE  ADDITIONS  TO  CONSIDER 

YTL 123^0 

• 

ADDITION  AND 

MULTIPLICATION  OF  NULL 

YTL 12350 

* 

MATRICES.  MARCH  1963 

YT  L 12360 

NAOOl 

LDQ 

FILLS 

B  IS  NULL 

YTL12370 

STQ 

LDMT 

YTL12380 

STA 

STMT 

YTL12390 

sue 

LC11 

YTL12400 

ADD 

LA  1 1 

YTL12410 

STA 

LDMT 

YTL12420 

LDMT 

LA11+MNA 

YTL 1 2430 

STMT 

STO 

***1 

LC11+MNC 

YTL12440 

T  I X 

*-2.1.1 

YTL12450 

TRA 

MMMR 

YTL 12460 

* 

A  IS  NULL  FOR  MMM3  OR  MMM4 

YTL12470 

LDMT  1 

LB11+MNB 

YTL 12480 

STMT  1 

STO 

**  •  2 

LC11+MNC 

YTL12490 

T  I  X 

STMT1+3.1.0 

NB 

YTL 12  500 

T  X I 

STMT1  +  1  .1 .0 

MN-1 

YTL12510 

T  IX 

LDMT1 .2.1 

YTL12520 

TRA 

MMMR 

YTL 12  5  30 

* 

YTL12540 

NMPY1 

SXA 

NLP  1.2 

YTL 12550 

LXA 

NLP  1.4 

YTL12560 
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NMPY 

STA 

NLP  1 

NULL  MATRIX  MULTIPLY 

YTL12570 

YTL125B0 

NLP  1 

STZ 

**  *  4 

YTL12590 

T  I X 

*-1.4.1 

YT  L 1 2600 

CLA 

WDMNL 

YTL12610 

STO* 

LC11 

YTLX2620 

MMMCF 

TRA 

CLA 

MMMR 

*1 

NON  CONFORMABLE  MATRICES. 

YTL12630 

YTL12640 

TRA 

MMME 

YTL12650 

YTL12660 

MOVE 

CLA  FILLO 

YTL12670 

STO  STAL1 

YTL12680 

LDQ 

MA 

YTL12690 

MPY 

NA 

YTL  12700 

TNZ 

*  +  3 

YTL12710 

XCA 

TZE 

TSX 

*  +  2 

CKDM1  *4 

ALLOW  A  MOVE  OF  0  X 
CHECK  DIMENSIONS  IN 

0.  M  X  0.  0  X  N 
FIELD  1 

YTL12720 
YT  L 12  7  30 
YTL12740 

LDO  MA 

YTL12730 

STO  MC 

YTL12760 

CLA  NA 

YTL12770 

STO  NC 

YTL127B0 

TRA  ELXEL 

matrix  ADD 

YTL12790 

MMM1 

LDQ 

FILLS 

YTL12800 

CLA 

FILL1 

YTL12810 

TRA 

*+3 

MATRIX  SUB 

YTL128Z0 

MMM2 

LDQ 

FILL6 

YTL12830 

CLA 

FILL2 

YT  L 1 2840 

STQ 

LDMT 

YTL12830 

STO  STAL1 

TSX  CKDM12.4 

CHECK  DIMENSIONS  IN 

FIELDS  1.2 

YTL12860 

YTL12870 

CLA  MA 

YTL12880 

STO  MC 

YTL12890 

sue  MB 
TNZ 

MMMCF 

non-conformable 

YTL 1 2900 
YTL12910 

CLA  NA 

YTL12920 

STO  NC 

YTL12930 

SUB  NB 
TNZ 

MMMCF 

non-conformable 

Y  T  L 1 2940 
YTL12930 

ELXEL 

LDQ  MA 

LOOP  CONTROL 

YTL12960 

MPY  NA 

YTL12970 

XCA 

MNA.B.C 

YTL12980 

PAX  O* 

1 

YTL12990 

ADD  LAI 1 

YTL13000 

STA  ITR81 

YTL13010 

SUB  L A 1 1 

YTL13020 

ADD  LB  1 1 

YTL13030 

STA  STAL1 

Y  T  L 13  040 

STA 

LDMT 

YTL13030 

SUB  LB11 

YTL13060 

ADD  LC11 

YTL  1307-0 

STA 

STMT 

YTL130B0 

STA  STAL1+1 

YTL 13090 

TSX 

CHKCOR  *4 

YTL 1 3 1 00 

LXD 

SP0T4  »4 

YTL13H0 

NZT 

5.4 

YTL13120 

TRA 

MOVEUP 

YTL13130 

ZET 

BNULL 

B  IS  NULL 

YTL13140 

TRA 

NADD1 

YTL13130 

ZET 

ANULL 

A  IS  NULL 

YTL 1 3 160 

TRA 

LDMT 
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ITR81  CLA 

0,1 

LA11+MNA 

YTL13170 

STAL1 

LB11+MNB 

YTL13180 

STO 

0,1 

LC11+MNC 

YTL131V0 

T  I X 

I TR81 ,1,1 

YTL13200 

TRA 

MMMR 

YTL13210 

MOVEUP  CLA 

3,4 

YTL13220 

SUB 

1,4 

YTL13230 

TMI 

ITR81 

MOVE  DOWN 

YTL13240 

CLA 

ITR81 

MOVE  UP 

YTL13250 

STA 

MSPOT1 

YTL13260 

CLA 

STAL1+1 

YTL13270 

STA 

MSPOT2 

YTL13280 

SXD 

MSPOT  3,1 

YTL13290 

AXT 

1,1 

YTL13300 

MSPOT1  CLA 

0,1 

LA11+MNA 

YTL13310 

MSPOT2  STO 

0,1 

LC11+MNC 

YTL13320 

TXI 

*+1,1,1 

YTL13330 

MSPOT3  TXL 

MSPOT 1,1,** 

MNA 

YTL13340 

TRA 

MMMR 

YTL13350 

REM 

PACKAGE  2  MMM3  ,4 

YTL13360 

REM 

ADD  AND  SUBTRACT 

TRANSPOSE 

YTL13370 

REM 

YTL13380 

MMM3  LDQ 

FILLS 

ADD  TRANSPOSE 

YTL13390 

CLA 

FILL3 

Y  TL 1 3400 

TRA 

*  +  3 

YTL 1 34 10 

MMM4  LDQ 

FILLS 

SUB  TRANSPOSE 

YTL13420 

CLA 

FILL4 

YTL13430 

STQ 

LDMT1 

YTL13440 

STO 

STAL2 

YTL13450 

TSX 

CKDM12 ,4 

CHECK  DIMENSIONS  OF  FIELDS  1,2 

YTL13460 

CLA 

MA 

YTL13470 

STO 

MC 

YTL13480 

SUB 

NB 

YTL13490 

TNZ 

MMMCF 

NON-CONFORMABLE 

YTL 1 3  500 

CLA 

NA 

YTL13510 

STO 

NC 

YTL13520 

SUB 

MB 

YTL 135  30 

TNZ 

MMMCF 

NON-CONFORMABLE 

YTL 1 3540 

TSX 

CHKCOR , 4 

YTL 1 3530 

LDQ 

MA 

LOOP  CONTROL 

YTL13560 

MPY 

NA 

YTL13570 

XCA 

YTL13580 

PAX 

0,1 

MNA»MNC 

YTL13590 

PAX 

0,2 

MNB 

YTL13600 

SUB 

■1 

YTL 1 36 10 

ALS 

18 

YTL13620 

STD 

STAL2+3 

YTL13630 

STD 

STMT  1  +  2 

YTL13640 

ARS 

18 

YTL136&0 

ADD 

=  1 

YTL13660 

ADD 

LAI  1 

YTL13670 

STA 

ITR82 

YTL13680 

SUB 

LAI  1 

YTL13690 

ADD 

LB1 1 

YTL13700 

STA 

STAL2 

YTL13710 

STA 

LDMT1 

YTL13720 

SUB 

LB  1 1 

YTL13730 

ADD 

LC11 

YTL13740 

STA 

STMT1 

YTL137&0 

ZET 

BNULL 

YTL13760 
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TRA 

NADD1 

B  IS  NULL 

YTL13770 

STA 

STAL2+1 

YTL13760 

CLA 

NB 

YTL13790 

ALS 

16 

YTL13800 

STD 

STMT  1  + 1 

YTL13810 

ZET 

ANULL 

YTL138A0 

TRA 

LDMT1 

YTL13830 

STD 

STAL2+2 

YTL13840 

ITR82 

CLA 

Oil 

LA11+MNA 

YTL138&0 

STAL2 

LB11+NMB 

YTL13860 

STO 

0*1 

LC11+MNC 

YTL13870 

T  IX 

ST  AL2  +  4  *2.0 

NB 

YTL13860 

T  X  I 

STAL2+2.2.0 

MN-1 

YTL13890 

T  I  X 

I TR02  *  1  *  1 

YTL 1 3900 

TRA 

MMMR 

YTL13910 

REM 

YTL 1 392o 

REM 

PACKAGE  3  MMM5 

YTL13930 

REM 

SCALAR  MULTIPLY 

YTL  1  3940 

REM 

YTL13950 

MMM5 

TSX 

CKDM2.4 

CHECK  DIMENSIONS  IN  FIELD 

2  YTL13960 

LDQ 

MB 

YT  L 1 39  70 

STD 

MC 

YTL13980 

CLA 

NB 

YTL13990 

STO 

NC 

Y  TL 1 4000 

TSX 

CHKCOR  .4 

YTL14010 

LDO 

MB 

YTL14020 

MPV 

NB 

YTL14030 

XCA 

YTL140A0 

PAX 

0*1 

MNB 

YTL  14050 

ADD 

LB  1 1 

YTL14060 

STA 

ITR83+1 

YTL14070 

SUB 

LB1  1 

YTL140B0 

ADD 

LC11 

YTL14090 

STA 

I TR  83  +  2 

YTL14100 

XCA 

YTL14110 

CLA 

YMAA 

YTL14120 

STA 

I  TR 83 

YTL14130 

PXA 

0.1 

YT  L 14 1 40 

PAX 

0*4 

YTL 141 50 

XCA 

YTL14160 

ZET 

BNULL 

YTL14170 

TRA 

NMPY 

B  IS  NULL 

YTL14160 

ITR83 

LDQ 

0 

LOC  A 

YTL 14190 

FMP 

0*1 

LOC  BMN+1 

YTL 142  00 

STO 

0*1 

LOC  CMN+1 

YTL14210 

T  I X 

I TR83 .1*1 

YTL14220 

TRA 

MMMR 

YTL14230 

* 

YTL142A0 

* 

PACKAGE  4.MMM6 

t MMM7  *  MMM8 

YTL 142  50 

* 

THESE  ARE  THE 

THREE  MULTIPLY  ROUTINES 

YTL14260 

* 

WHICH  ARE  WRITTEN  FOR  THE  7094 

YTL 1 42  70 

* 

THEY  USE  COMMON  MULTIPLY  INSTRUCTIONS 

YTL 14280 

* 

AND  A  DFAD.  INCLUDES  A  NULL  MULTIPLY 

YTL14290 

* 

ADDED  5/63 

YTL 14300 

£ 

YTL14310 

MMM6 

CLA 

NA 

MULTIPLY 

YTL14320 

SUB 

MB 

YTL  14330 

TNZ 

mmmcf 

CONFORMABILITY  CHECK 

YT  L 1 4340 

TSX 

CKDM12  *4 

CHECK  DIMENSIONS 

YTL14350 

LXA 

MA  *  3 

TOTAL  ROWS  OF  A 

YTL14360 
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* 


LXA 

SXA 

LDQ 

STQ 

MPY 

XCA 

PAX 

ADD 

STA 

TSX 

LXA 

CAL 

ACL 

TNZ 

CLA 

STO 

STO 

ADD 

STA 

LDQ 

MPY 

XCA 

STO 

ADD 

STA 

LXA 

SXD 

SXA 

LXA 

SXD 

TRA 


NB  *  4 

TOTAL  COLUMNS  OF  B 

NC  *4 

COLUMN  DIMENSION  OF  PRODUCT 

MA 

MC 

ROW  DIMENSION  OF  PRODUCT 

NB 

0.5 

TOTAL  NO.  OF  ELEMENTS  IN  PRODUCT 

LC11 

ANSWER 

STORAGE  OF  ANSWER 

CHKCOR  *4 

NB  •  4 

ANULL 

CHECK  FOR  A  OR  B  NULL 

BNULL 

ZROMPY 

NA 

TOTA 

NUMBER  OF  ELEMENTS  IN  ROW  OF  A 

INCRMA 

STORAGE  INCREMENT  FROM  ROW  TO  ROW 

LAI  1 

ELEMA 

ADDRESS  FOR  A 

MB 

NB 

TOTB 
LB  1 1 
ELEMB 
=  1  .1 

MPTST1 .1 
I NCRMB  » 1 
NB.l 

MPT  ST  1  +  1 1 1 

multpy 

SET  UP  CONTROL  NUMBERS  FOR  MMM7 


TOTAL  NUMBER  OF  ELEMENTS  IN  B 
ADDRESS  FOR  B 
DECREMENT  FOR  A 

STORAGE  INCREMENT  FROM  COL.  TO  COL. 
DECREMENT  FOR  B 


MMM7  CLA 
SUB 
TNZ 
TSX 
LXA 
LXA 
SXA 
LDQ 
STQ 
MPY 
XCA 
PAX 
ADD 
STA 
TSX 
LXA 
CAL 
ACL 
TNZ 
CLA 
STO 
STO 
ADD 
STA 
CLA 
crn 


NA 

POST  MULTIPLY  BY  TRANSPOSE 

NB 

MMMCF 

CONFORMABILITY  CHECK 

CKDM12  .4 

CHECK  DIMENSIONS 

MA  t  3 

TOTAL  ROWS  IN  A 

MB. 4 

TOTAL  ROWS  IN  B 

NC.4 

COLUMN  DIMENSION  OF  PRODUCT 

MA 

MC 

ROW  DIMENSION  OF  PRODUCT 

MB 

0.5 

TOTAL  NUMBER  OF  ELEMENTS  IN  PRODUCT. 

LC11 

ANSWER 

STORAGE  OF  ANSWER 

CHKCOR .4 

MB  .4 

ANULL 

CHECK  FOR  A  OR  B  NULL 

BNULL 

ZROMPY 

NA 

TOTA 

NUMBER  OF  ELEMENTS  IN  ROW  OF  A 

INCRMA 

STORAGE  INCREMENT  FROM  ROW  TO  ROW 

LA  1 1 

ELEMA 

ADDRESS  FOR  A 

NB 

NUMBER  OF  ELEMENTS  IN  ROW  OF  B 

TOTR 

YTL14370 
YTL14380 
Y  TL 14390 
YTL14400 
YTL14410 
YTL14420 
YTL14430 
YTL14440 
YTL14450 
YTL14460 
YTL14470 
YTL14480 
YTL14490 
YTL 14500 
YTL14510 
YTL145Z0 
YTL14530 
YTL14540 
YTL14550 
YTL14560 
YTL14570 
YTL14580 
YTL14590 
YTL 14600 
YTL14610 
YTL14620 
YTL 14630 
YTL14640 
YTL14650 
YTL14660 
YTL14670 
YTL14680 
YTL 14690 
YTL 14700 
YTL14710 
YTL14720 
YTL 147  30 
YTL147^0 
YTL14750 
YTL14760 
YTL14770 
YTL14780 
YTL14790 
YTL14800 
YTL14810 
YTL14820 
YTL14830 
YTL14840 
YTL148S0 
YTL 14860 
YTL14870 
YTL14880 
YTL 14890 
YTL14900 
YTL14910 
YTL14920 
YTL14930 
YTL 149^0 
YTL14950 
YTL14960 
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STO 

ADD 

STA 

LXA 

SXD 

SXD 

TRA 


MMM6  CLA 

SUB 

TNZ 

TSX 

LXA 

SXA 

LXA 

SXA 

LDQ 

MPY 

XCA 

PAX 

ADD 

STA 

TSX 

LXA 

CAL 

ACL 

TNZ 

LXA 

SXD 

LDQ 

MPY 

XCA 

STO 

ADD 

STA 

LXA 

SXD 

LDQ 

MPY 

XCA 

STO 

ADD 

STA 

CLA 

STO 

STO 

TRA 

2ROMPY  CLA 
STZ 
TNZ 
CAL 
SLW* 
TNX 
STZ* 
T  IX 
TRA 


INCRMB  STORAGE  INCREMENT  FROM  ROW  TO  ROW 

LB  1 1 

ELEMB 

*1*1 

MPTST 1*1  DECREMENT  FOR  A 

MPTST1+1.1  DECREMENT  FOR  B 

MULTPY 

SET  UP  CONTROL  NUMBERS  FOR  MMM8 

PRE  MULTIPLY  BY  TRANSPOSE 

CONFORM AB I L I TY  CHECK 
CHECK  DIMENSIONS 
TOTAL  COLUMNS  OF  A 
ROW  DIMENSION  OF  PRODUCT 
TOTAL  COLUMNS  OF  B 
COLUMN  DIMENSION  OF  PRODUCT 


0.5 
LC11 
ANSWER 
CHKCOR  *4 
NB.4 
ANULL 
BNULL 
ZROMPY 
N  A  *  1 

MPTST 1  *  1 
NA 
MA 

TOTA  total  number  of  elements  in  a 

LA  1 1 

ELEMA  address  for  a 

NB  » 1 

MPTST1+1.1  decrement  for  B 

NB 
MB 

TOTB 
LB  1 1 
ELEMB 
=  1 

INCRMA 
INCRMB 
MULTPY 
MAD 
MAD 
MMMR 
WDMNL 
LC11 

MMMR *5*1 
ANSWER 
*— 1  *  5  *  1 
MMMR 

MULTIPLY  LOOP  USED  BY  MMM6.7.8 


TOTAL  NUMBER  OF  ELEMENTS  IN  8 

ADDRESS  FOR  B 

INCREMENT  FOR  A 
INCREMENT  FOR  B 


TOTAL  NUMBER  OF  ELEMENTS  IN  PRODUCT 
STORAGE  OF  ANSWER 

CHECK  FOR  A  OR  B  NULL 

DECREMENT  FOR  A 


MA 

MB 

MMMCF 
CKDM12  *4 
NA  *  3 
MC.3 

NB. 4 

NC. 4 
NA 
NB 


YTL14970 
YTL1490O 
YTL14990 
YTL15000 
YTL 150 10 
YTL15020 
YTL15030 
YTL15040 
YTL15050 
YT  L 1 5060 
YTL15070 
YT  L 1 5000 
YTL15090 
YTL15100 
YTL15H0 
YTL15120 
YTL15130 
YTL15140 
YTL15150 
YTL15160 
YTL15170 
YTL15180 
YTL15190 
YTL15200 
YTL152 10 
YTL15220 
YTL15230 
YTL15240 
YTL15250 
YTL15260 
YTL15270 
YTL1520O 
YTL1S290 
YTL15300 
YTL15310 
YTL15320 
YTL15330 
YTL15340 
YTL15350 
YTL15360 
YTL15370 
YTL15360 
YTL15390 
YTL15400 
YTL15410 
YT  L 15420 
YTL15430 
YTL15440 
YTL15450 
YT  L 15460 
YTL15470 
YTL 15400 
YTL15490 
YTL15500 
YTL15510 
YTL15520 
YTL15530 
YTL 15540 
YTL15550 
YTL15560 
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MULTPY 

PXA 

DOTPRD.O 

CLA 

LBT 

*-l 

TRA 

*+2 

ADD 

■1 

STA 

SUMPRD 

CLA 

MAD 

TZE 

NOADD 

CAL 

MADYES 

SLW 

ANSWER-2 

STZ 

MAD 

TRA 

*+3 

NOADD 

CAL 

MADNO 

SLW 

ANSWER-2 

strtlp 

LXA 

TOT  A .  1 

LXA 

TOTB.2 

LDQ 

•  0 

PXA 

0*0. 

DST  * 

SUMPRD 

ZROTST 

NZT  * 

ELEMA 

TRA 

MPTST1 

NZT* 

ELEMB 

TRA 

MPTST1 

ELEMA 

LDQ 

**,1 

ELEMB 

FMP 

**.2 

SUMPRD 

DFAD 

*# 

DST* 

*-l 

MPTST1 

T  IX 

*+1.1 *** 

T  IX 

ZROTST. 2.** 

htr 

FRN 

MMMR 

ANSWER 

STO 

**  .  5 

T  IX 

*+1.5.1 

TNX 

NEWRCA .4.1 

CLA 

ELEMB 

ADD 

INCRMB 

STA 

ELEMB 

TRA 

STRTLP 

NEWRCA 

TNX 

MMMR .3.1 

LXA 

NC.4 

CLA 

ELEMA 

ADD 

INCRMA 

STA 

ELEMA 

CLA 

LB  1 1 

ADD 

TOTB 

STA 

ELEMB 

TRA 

REM 

STRTLP 

REM 

PACKAGE  5  MM 

REM 

REM 

MATRIX  TRANSPOSE 

MMM9 

TSX 

CKDM1.A 

CLA 

MA 

STO 

NC 

ALS 

18 

STD 

ITR85+3 

LDO 

NA 

STO 

MC 

TSX 

CHKC0R.4 

PUT  IN  ADD  FOR  MPY  AND  ADD 


MULTIPLY  ONLY .USE  DUMMY 


ZERO  DOT  PRODUCT 


ELEMENT  OF  A 
ELEMENT  OF  B 
RUNNING  PRODUCT 

DECREMENT  FOR  A 
DECREMENT  FOR  B 

VARIABLE  CELL  FOR  OP.  CODES  30.31.32 
STORE  DOT  PRODUCT 

TRA  IF  A  NEW  ROW  OR  COLUMN  OF  A  IS  NEEDED 
GET  NEW  COLUMN  OR  ROW  OF  B. 


NEXT  ELEMENT  OF  ROW  OF  PRODUCT 
COUNT  OF  ROWS  OR  COLUMNS  OF  A  USED 
RE-SET  COUNT  OF  ROWS  OR  COLS  OF  B 
GET  NEW  ROW/COLUMN  OF  A 


START  OVER  WITH  STORAGE  ACCESS  TO  B 


YTL15570 
YTL15580 
YTL15590 
YTL15600 
YTL15610 
YTL15620 
YTL15630 
YTL156A0 
YTL156&0 
YTL15660 
YTL15670 
YTL15680 
YTL15690 
YTL15700 
YTL15710 
YTL15720 
YTL15730 
YTL157A0 
YTL15750 
YTL15760 
YTL15770 
YTL15780 
YTL15790 
YTL15800 
YTL15B10 
YTL1502O 
YTL15830 
YTL 1 58 AO 
YTL158&0 
YTL15860 
YTL15870 
YTL15880 
YTL15890 
YTL15900 
YTL15910 
YTL15920 
YTL15930 
YTL159A0 
YTL159&0 
YTL15960 
YTL15970 
YTL15980 
YTL15990 
YTL16000 
YTL16010 
YTL16020 
YTL16030 
YTL160A0 
YTL16050 
YTL16060 
YTL16070 
YTL16080 
YTL16090 
YTL16100 
YTL16H0 
YTL16120 
YTL16130 
YTL161A0 
YTL 161 50 
YTL16160 
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ITR85 


MMM10 

MMM11 


LOO 

NA 

YTL16170 

MPY 

MA 

YTL16160 

XCA 

YTL16190 

PAX 

0.1 

YTL16200 

PAX 

0.4 

YTL16210 

ADD 

LAI  1 

YTL16220 

STA 

ITR05 

YTL16230 

SUB 

LA  1 1 

YTL16240 

ADD 

LCU 

YTL16250 

ZET 

ANULL 

YTL16260 

TRA 

NMPY 

A  IS  NULL 

YTL16270 

STA 

ITR85+1 

YT  L 162  80 

SUB 

LC11 

YTL16290 

ALS 

16 

YTL16300 

CHS 

YTL16310 

ADD 

I TR  85+  3 

YTL16320 

COM 

YTL16330 

STD 

I TR85+4 

YTL16340 

CLA 

0.1 

LA11+MNA 

YTL163S0 

STO 

0.4 

LC11+MNC 

YTL16360 

TNX 

MMMR .1.1 

YTL16370 

T  I X 

ITR85 ,4,0 

NC 

YTL16380 

T  X I 

ITR85.4.0 

MNC-NC-1 

YTL 16390 

REM 

YTL16400 

REM 

PACKAGE  6 

MMM10.il 

YTL16410 

REM 

ADD,  SUBTRACT 

DIAGONAL  MATRIX 

YTL16420 

REM 

YTL16430 

REM 

YTL 16440 

CLA 

FIL10 

ADD  DIAGONAL 

YTL16450 

CAS 

FIL10 

YTL  16460 

CLA 

FIL11 

SUB  DIAGONAL 

YTL 16470 

STO 

STAL6 

YTL16480 

CLA 

FILLS 

INITIALIZE  ITR86 

WITH 

CLA  0.1 

YTL 16490 

STO 

ITR86 

YTL 16500 

TSX 

CKDM12 .4 

CHECK  DIMENSIONS 

IN  FIELDS  1,2 

YTL 16510 

TSX 

CKDG2 .4 

YTL16520 

CLS 

-1 

LOOP  CONTROL 

YTL 16530 

ADD 

MB 

YTL16540 

ADD 

NB 

YTL16550 

SUB 

MA 

YT  L 16560 

TNZ 

MMMCF 

NON-CONFORMABLE 

YTL16570 

ADD 

MA 

YTL16580 

ADD 

LB  1 1 

YTL  16590 

STA 

STAL6 

YTL  16600 

SUB 

LB  1 1 

YTL16610 

ALS 

18 

YTL 16620 

STD 

ITR86+3 

YTL 16630 

ARS 

18 

YTL16640 

PAX 

0.2 

NB 

YTL16650 

SUB 

NA 

YTL16660 

TNZ 

MMMCF 

NON-CONFORMABLE 

YTL16670 

LDO 

MA 

YTL16680 

STO 

MC 

YTL16690 

STO 

NC 

YTL 16700 

TSX 

CHKC0R.4 

YTL16710 

LDQ 

MA 

YTL16720 

MPY 

NA 

YTL16730 

XCA 

Y  T  L 16740 

PAX 

0,1 

MNA 

YTL16750 

ADD 

LAI  1 

YTL16760 
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I  TR86 
STAL6 


MMM 1 2 


SCAR  1 


STA 

ITR86 

YTL16770 

SUB 

LAI  1 

YTL16780 

ADD 

LC1 1 

YTL1&790 

STA 

ITR86+ 5 

YTL16800 

AXT 

1*4 

YTL16810 

ZET 

BNULL 

YTL16820 

TRA 

NADD1 

B  IS  NULL 

YTL16830 

CLA 

FILL7 

YTL16840 

ZET 

ANULL 

YTL16850 

STO 

ITR86 

A  IS  NULL 

YTL16860 

CLA 

0*1 

LA11+MNA 

YTL16870 

T  IX 

ITR86t-5.4*l 

LB11+NB 

YTL16880 

YTL16890 

TXI 

1 TR86  +  4  *4  *0 

MA 

YTL16900 

TNX 

ITR86f5*2*l 

YTL16910 

STO 

0*1 

LC11+MNC 

YTL16920 

T  I X 

I TR86  *  1  *  1 

YTL16930 

TRA 

REM 

MMMR 

YTL16940 

YTL169&0 

REM 

PACKAGE  7  MMM12.13.14.15.16 

YTL16960 

REM 

MULTIPLY  MATRIX 

OR  TRANSPOSE  PRE  OR  POST  BY  DIAGONAL 

YTL16970 

REM 

REM 

REM 

MULTIPLY  DIAGONAL  BY  DIAGONAL  OR  TWO  MATRICES  BY  ELEMENT 

YTL16980 

YTL16990 

PACKAGE  7.1  MMM12 

YTL17000 

REM 

POST  MULTIPLY  BY 

DIAGONAL 

YTL17010 

TSX 

CKDM12  *4 

CHECK  DIMENSIONS  IN  FIELDS  1*2 

YTL17020 

TSX 

CKDG2 • 4 

YTL17030 

CLA 

NA 

POST  MPY  BY  DIAGONAL 

YTL17040 

STO 

NC 

YTL170&0 

PAX 

0*2 

NB 

YTL17060 

ADD 

LB11 

YTL17070 

STA 

SCAR1+1 

YTL17080 

SUB 

LB1 1 

YTL17090 

ADD 

■  1 

YTL17100 

SUB 

MB 

YTL17H0 

SUB 

NB 

YTL17120 

TNZ 

MMMCF 

NON-CONFORMABLE 

YTL17130 

CLA 

NA 

YTL17140 

SUB 

■  1 

YTL17150 

ALS 

18 

YTL17160 

STD 

SCAR1+5 

YTL17170 

LDQ 

MA 

YTL17180 

STO 

MC 

YTL17190 

TSX 

CHKCOR  *4 

YTL17200 

LDQ 

MA 

YTL 172 10 

MPY 

XCA 

NA 

YTL17220 

YTL17230 

PAX 

0*1 

MNA 

YTL17240 

PAX 

0*4 

YTL17250 

ADD 

LA  1 1 

YTL17260 

STA 

SCAR1 

YTL17270 

SUB 

LA  11 

YTL17280 

ADD 

LC11 

YTL17290 

ZET 

ANULL 

YTL17300 

TRA 

NMPY 

A  IS  NULL 

YTL17310 

ZET 

BNULL 

YTL17320 

TRA 

NMPY 

B  IS  NULL 

YTL17330 

STA 

SCAR1+2 

YTL17340 

LDQ 

0*1 

LAU+MNA 

YTL17350 

FMP 

0*2 

LB1 1+NB 

YTL1736Q 
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STO 

0*1 

TNX 

MMMR.ltl 

TIX 

SCAR1 *2*1 

TXI 

SCAR1 *2*0 

REM 

PACKAGE  7.2 

REM 

PRE  MULTIPLY 

MMM13  TSX 

CKDM12.4 

TSX 

CKDG1.4 

CLA 

MB 

STO 

MC 

PAX 

0*1 

ADD 

LA11 

STA 

SCAR2 

SUB 

LA  11 

ADD 

■1 

SUB 

MA 

SUB 

NA 

TNZ 

MMMCF 

CLA 

NB 

STO 

NC 

TSX 

CHKC0R.4 

CLA 

NB 

PAX 

0*4 

SUB 

*1 

ALS 

18 

STD 

SCAR2+5 

LDO 

MB 

MPY 

NB 

LCU+MNC 


NB-1 

MMM13 

BY  DIAGONAL 

CHECK  DIMENSIONS  IN  FIELDS  1*2 
PRE  MPY  BY  DIAGONAL 
NA 


NON  CONFORMABLE 


NB 


XCA 

PAX 

ADD 

STA 

SUB 

ADD 

ZET 

TRA 

ZET 

TRA 

STA 

SCAR2  LDO 
FMP 
STO 
TNX 
T  IX 
TXI 
TIX 
REM 
REM 

MMM14  TSX 
TSX 
CLA 
STO 
ADD 
STA 
SUB 


0 • 2  MNB 

LB1 1 
SCAR2+1 
LB1 1 
LC11 

ANULL 
NMPY1 
BNULL 
NMPY1 
SCAR2+2 

0*1 

0*2 
0*2 

MMMR»2  *1 
SCAR2  *4*1 

SCAR2+6  *4.0 

SCAR2  *  1*1 

PACKAGE  7.3  MMM14 
POST  MULTIPLY  TRANSPOSE  BY  DIAGONAL 
CKDM12.4 
CKDG2.4 


A  IS  NULL 

B  IS  NULL 

LA11+NA 

LB11+MNB 

LC11+MNC 


NB-1 


MA 

NC 

LB1 1 
SCAR3+2 
LB  1 1 


CHECK  DIMENSIONS  IN  FIELDS  1.2 
POST  MPY  TRANSPOSE  BY  DIAGONAL 


ADD 

-1 

SUB 

MB 

SUB 

NB 

TNZ 

MMMCF 

NON-CONFORMABLE 

CLA 

NA 

YTL17370 
YTL17360 
YTL17390 
YTH7400 
YTL17410 
YTL17420 
YTL17430 
YTL17440 
YTL17450 
YTL17460 
YTL17470 
YTL17480 
YTL17490 
YTL17500 
YTL17510 
YTL175Z0 
YTL17530 
YTL17540 
YTL175&0 
YTL17560 
YTL17570 
YTL17580 
YTL17590 
YTL17600 
YTL17610 
YTL17620 
YTL17630 
YTL17640 
YTL176S0 
YTL17660 
YTL17670 
YTL17680 
YTL17690 
YTL17700 
YTL17710 
YTL177Z0 
YTL17730 
YTL17740 
YTL17750 
YTL17760 
YTL17770 
YTL17780 
YTL17790 
YTL17800 
YTL17810 
YTL17820 
YTL17830 
YTH7840 
YTL178&0 
YTL17860 
YTL17870 
YTL17880 
YTL17890 
YTL17900 
YTL 179 10 
YTL179Z0 
YTL17930 
YTL17940 
YTL17950 
YTL 17940 
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STO 

ALS 

STO 

AOO 

STD 

TSX 

LDQ 

MPY 

XCA 

PAX 

PAX 

ADD 

STA 

SUB 

PAX 

ADD 

ZET 

TRA 

ZET 

TRA 

STA 

TXI 

PACH3  T IX 
TXI 
SXD 

SCAR 3  LXA 
LDQ 
FMP 
STO 
TNX 
TNX 
T  IX 
TXI 
REM 
REM 

MMM15  TSX 

TSX 

CLA 

STO 

PAX 

SXD 

ADD 

STA 

SUB 

ADD 

PAX 

SXD 

SUB 

SUB 

TNZ 

LDQ 

STQ 

TSX 

LDQ 

MPY 

XCA 

PAX 

TXI 

PACHA  T I X 
TXI 


MC 

18 


SCAR3+5 

-1B17 

PACH3 

CHKCOR  * A 
MA 
NA 


0*1 

0*4 

LA11 

SCAR3+1 

LAI  1 

0*2 

LC11 

ANULL 


NMPY 

A  IS  NULL 

8NULL 

NMPY 

B  IS  NULL 

SCAR3+3 

•♦1*2.2 

*♦1*2*** 

**»NA+1 

*♦1 *2  *“2 

SCAR3+7 .2 

NC*  2 

NB 

0*1 

LA11+NMA 

0*2 

LB11+NB 

0*4 

LC11+MNC 

MMMR.A.l 

SCAR3+6 .1.0  NA 

SCAR3+1 *2*1 
SCAR3  *1*0 

NMA-NA-1 

PACKAGE  7. A 

MMM15 

PRE  MULTIPLY 

TRANSPOSE  BY  DIAGONAL 

IN  FIELDS  1*2 

CKDM12.A 

CHECK  DIMENSIONS 

CKDG1 »A 

NB 

PRE  MPY  TRANSPOSE 

BY  DIAGONAL 

MC 

0*1 

NB 

SCARA+A* 1 

LAI  1 
SCARA 
LAI  1 

•1 

0*2 

PACHA *2 
MA 
NA 

MMMCF 
MB 
NC 

CHKCOR  *  A 
MB 
NB 

0*2  NMB 

*♦1.2.2 

*♦1.2.**  **«NBa1 

*♦1.2. -2 


NB+1 

NON-CONFORMABLE 


YTL17970 
YTL17980 
YTL17990 
YTL18000 
YTL18010 
YTL18020 
YTL18030 
YTL18040 
YTL18050 
YTL18060 
YTL18070 
YTL18080 
YTL18090 
YTL18100 
YTL18110 
YTL18120 
YTL18130 
YTL181A0 
YTL18150 
YTL18160 
YTL18170 
YTL18180 
YTL18190 
YTL18200 
YTL 182 10 
YTL18220 
YTL18230 
YTL182A0 
YTL18250 
YTL 18260 
YTL18270 
YTL18280 
YTL18290 
YTL18300 
YTL18310 
YTL18320 
YTL18330 
YTL18340 
YTL  18350 
YTL18360 
YTL18370 
YTL  1 8380 
YTL18390 
YTL18400 
YTL18A10 
YTL18A20 
YTL18A30 
YTL18A40 
YTL18A&0 
YTH8A60 
YTL1BA70 
YTL18A80 
YTL18A90 
YTL18500 
YTL18510 
YTL 1 85  2o 
YTL18530 
YTL185A0 
YTL18550 
YTL 1 8560 


SCAR4 


MMM16 


XCHK  1 


XCHK2 


ITR87 


SXD 
PAX 
PAX 
ADD 
STA 
SUB 
ADD 
ZET 
TRA 
2ET 
TRA 
STA 
LDQ 
FMP 
STO 
TNX 
T  I X 
TXI 
T  I X 
REM 
REM 


NMC 

NMB 


SCAR4+5  * 2 

0,4 

0,2 

LB11 
SCAR4+1 
LB  1 1 
LC11 

ANULL 
NMPY 
BNULL 
NMPY 
SCAR4+2 

0,1 
0,2 
0,4 

MMMR ,4,1 
SCAR4 ,2,0 

SCAR4+6 ,2,0 
SCAR4 ,1,1 

PACKAGE  7.5  MMM16 

MULTIPLY  DIAGONAL  BY  DIAGONAL,  OR  TWO  MATRICES  BY  ELEMENT 
CHECK  DIMENSIONS  IN  FIELDS  1,2 


MPY  DIAGONAL  BY  DIAGONAL 


A  IS  NULL 

B  IS  NULL 

LA11+NA 

LB11+NMB 

LC11+MNC 

NB 

NM8-NB- 1 


TSX 

CKDM12 ,4 

TSX 

CKDG1 ,4 

TSX 

CKDG2 ,4 

CLA 

MA 

SUB 

MB 

TNZ 

XCHK1 

CLA 

NA 

SUB 

NB 

TNZ 

MMMCF 

TRA 

XCHK2 

CLA 

MA 

SUB 

NB 

TNZ 

MMMCF 

CLA 

NA 

SUB 

MB 

TNZ 

MMMCF 

CLA 

•1 

STO 

MC 

LDQ 

MA 

MPY 

NA 

XCA 

STO 

NC 

TSX 

CHKCOR  ,  4 

CLA 

NC 

PAX 

0,1 

PAX 

0,4 

ADD 

LA  1 1 

STA 

ITR87 

SUB 

LAI  1 

ADD 

LB1 1 

STA 

ITR87+1 

SUB 

LB11 

ADD 

LC11 

ZET 

ANULL 

TRA 

NMPY 

ZET 

BNULL 

TRA 

NMPY 

STA 

ITR87+2 

LDQ 

0,1 

NON-CONFORMABLE 


NON-CONFORMABLE 


NON-CONFORMABLE 


NA,B»C 


A  IS  NULL 
B  IS  NULL 
LA11+NA 


YTL18570 
YTL18580 
YT  L 1 8590 
YTL18600 
YTL18610 
YTL18620 
YTL18630 
YTL18640 
YTL18650 
YTL18660 
YTL18670 
YTL18680 
YTL18690 
YTL187O0 
YTL18710 
YTL18720 
YT  L 1 87  30 
YTL18740 
YTL18750 
YTL18760 
YTL18770 
YTL18780 
YTL18790 
YTL18800 
YTL18810 
YTL18820 
YTL18830 
YTL18840 
YTL  18850 
YTL18860 
YTL18870 
YTL18880 
YTL18890 
YTL 18900 
YTL18910 
YTL 18920 
YT  L 1 8930 
YTL 1 8940 
YT  L 1 8950 
YTL 18960 
YTL18970 
YTL 18980 
YTL18990 
YTL 1 9000 
YTL19010 
YTL19020 
YTL  19030 
YT  L 19040 
YTL19050 
YTL19060 
YTL19070 
YTL 19080 
YTL 19090 
YTL 19100 
YTL19U0 
YTL19120 
YTL19130 
YTL19140 
YTL19150 
YTL19160 
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* 

* 

« 

* 

* 

* 

* 

* 


FMP 

0*1 

LB11+NB 

STO 

0,1 

LC11+NC 

T  I X 

1TR87,1,1 

TRA 

MMMR 

REM 

REM 

PACKAGE  8 

MMM17 

REM 

ADO  CONSTANT 

TIMES  UNIT  MATRIX 

REM 

MMM17  CLA 

MA 

ADD  K I 

SUB 

NA 

TZE 

*+3 

CLA 

-2 

MATRIX  NOT  SQUARE 

TRA 

MMME 

ZET 

ANULL 

STZ* 

LAI  1 

CLA 

MA 

LOOP  CONTROL 

STO 

MC 

STO 

NC 

ALS 

18 

STD 

ITR88+3 

LDO 

MA 

MPY 

NA 

XCA 

PAX 

0,1 

ADD 

LAI  1 

STA 

ITR88 

SUB 

LAI  1 

ADD 

LC11 

STA 

ITR88+4 

CLA 

2,4 

STA 

I TR88+2 

TSX 

CKDM1 ,4 

CHECK  DIMENSIONS  IN  FIELD  1 

TSX 

CHKCOR ,  4 

CLA 

-1 

PAX 

0,2 

ONE 

ITR88  CLA 

0-1 

TA11+MNA 

T  IX 

I TR88+4 ,2,1 

FAD 

0 

LOC  B 

TXI 

I TR88+4 ,2 , 0 

MA 

STO 

0,1 

LC11+MNC 

T  IX 

ITR8  ,1,1 

CLA 

LA  1 1 

SUB 

LC11 

TZE 

MMMR 

CLA 

WDMNL 

ZET 

ANULL 

STO*  LA11 
TRA  MMMR 

PACKAGE  9*  MMM18  MATRIX  INVERSION 
USES  I NV4 »  7094  INVERSION  WHICH  UTILIZES 

THE  HARDWARE  DOUBLE  PRECISION 

FIELD  2  OPTION  DESCRIPTION 

FIELD  2  -  -It  PRINT  DETERMINANT 

FIELD  2  -  -2  #  HAVE  CONDITIONING  INFO#  PRINTED 

FIELD  2  -  -3  t  DO  BOTH 


YTL19170 

YTL19180 

YTL19190 

YTL19200 

YTL19210 

YTL19220 

YTL19230 

YTL192^0 

YTL19250 

YTL19260 

YTL19270 

YTL19280 

YTL19290 

YTL19300 

YTL19310 

YTL19320 

YTU19330 

YTL19340 

YTL193&0 

YTL19360 

YTU19370 

YTL 19380 

YTL19390 

YTL19400 

YTL19410 

YTL19420 

YTL19430 

YTL 1 9440 

YTL19450 

YTL19460 

YTL19470 

YTL19480 

YTL19490 

YTL 19500 

YTL19510 

YTL  19520 

YTL19530 

YTL19540 

YTL19550 

YTL 19560 

YTL 19570 

YTL19580 

YTL19590 

YTL19600 

YTL19610 

YTL19620 

YTL19630 

YTL19640 

YTL196&0 

YTL19660 

YTL19670 

YTL 19680 

YTL19690 

YTL 19700 

YTL19710 

YTL 19720 

YTL 19730 

YTL19740' 

YTL197&0 

YTL 19760 
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MMM18 

TSX 

CKDM1 #4 

CHECK  DIMENSIONS 

YTL19770 

CLA 

MA 

YTL19780 

SUB 

NA 

YTL19790 

TZE 

*+3 

YTL19800 

CLA 

•2 

NOT  SQUARE 

YTL19810 

TRA 

MMME 

YTL19820 

CLA 

ANULL 

YTL19830 

TZE 

NOTNUL 

YTL19840 

CLA 

'11 

YTL19880 

TRA 

MMME 

YTL19860 

NOTNUL 

CLA 

NA 

YTL19870 

STO 

MC 

YTL19880 

STO 

NC 

YTL19890 

LDQ 

NA 

YTL19900 

MPY 

NA 

YTL19910 

STO 

NSQ 

YTL19920 

ROL 

1 

YTL19930 

STO 

TWONSQ 

2NSQ 

YTL19940 

CLA 

TWONSQ 

YTL19930 

ADD 

NA 

Y  T  L 19980 

ADD 

NA 

YTL19970 

ADD 

'6 

YTL19980 

ADD 

LC11 

LCll+2*N**2+2*N+6 

YTL19990 

CAS 

HICORE 

YTL20000 

TRA 

OVER 

YTL20010 

TRA 

*+l 

YTL20020 

CLA 

LC11 

YTL20030 

LBT 

YTL200i*0 

TRA 

*  +  2 

MAKE  SURE  ADDRESS  IS  EVEN 

YTL20030 

ADD 

'1 

YTL20060 

STA 

GO  +  4 

YTL20070 

CLA 

LAU 

YTL20080 

ADD 

NSQ 

YTL20090 

STA 

GET1 

YTL20100 

CLA 

GO+4 

YTL201 10 

ADD 

TWONSQ 

YTL201Z0 

STA 

STOl 

YTL20130 

CLA 

LC11 

YTL201^0 

CAS 

LA  1 1 

YTL20 1 30 

TRA 

TOPFST 

IF  INVERTED  FORWARDS.  MOVE  FROM  TOP 

DOWN  YTL20160 

TRA 

TOPFST 

IF  INVERTED  OVER  ITSELF*  MOVE  FROM 

TOP  DOWNYT L20 1 70 

BOTFST 

LXA 

NSQ  *  1 

IF  INVERTED  BACKWARDS. MOVE  FROM  BOTTOM  FSTYTL20180 

LXA 

TWONSQ >2 

YTL20190 

GET  1 

CLA 

**  »  1 

LA  1 1  +  NSQ 

YTL20200 

STOl 

STO 

**  *  2 

LC11 ( EVEN )  +  2*N**2 

YTL20210 

T  I X 

*+1*2*1 

YTL20220 

STZ* 

*-2 

YTL20230 

T  I X 

*+1.2*1 

YTL20240 

T  IX 

GET  1  *  1 » 1 

YTL202&0 

TRA 

INVERT 

YTL20260 

TOPFST 

LXA 

NSQ  *  1 

EXPAND  THIS  WAY  FOR  INVERSION  OVER 

ITSELF  YTL20270 

SXD 

LP  END  *  1 

YTL20280 

AXT 

1.1 

YTL20290 

AXT 

1.2 

YTL20300 

GET  2 

CLA* 

GET  1 

YTL203  1 0 

STZ* 

STOl 

YTL203Z0 

TXI 

*+1*2*1 

YTL20330 

STO* 

STOl 

YTL203A0 

TXI 

*+1*2*1 

YTL203&0 

TXI 

*+1*1*1 

YTL2036Q 

LPEND 

TXL 

GET2*1***  N**2  IN  DECREMENT 

INVERT 

CLA 

YMBB  CHECK  FOR  OPTIONAL  DIAGONAL  TERM  PRINT 

TZE 

GO 

TMI 

*  +  3 

CLA 

*35  FIELD  MUST  BE  NEGATIVE 

TRA 

MMME 

PAX 

0*7 

TXH 

*-3*7*3  ONLY  1*2*  OR  3 

TXL 

60+1*7*1  1  IS  JUST  DETERMINANT 

CLA 

SSM 

NA 

STO 

NA 

TRA 

*  +  2 

00 

LXA 

=0,7  CLEAR  XR7  IF  FIELD  2-0 

CALL 

ZAC 

INV4DS(**.NA,IRR1*IRR2.SCALE*DET .NDETXP) 

STP 

NA 

CLA 

IRR1 

TZE 

GOOD 

INVE 

CALL 

.FWRD.(.UN06.*INVFMT)  error  print 

CLA 

IRR  1 

TSX 

.FCNV.,4 

CLA 

I RR2 

TSX 

•  FCNV  •  *  4 

CLA 

SCALE 

TSX 

.FCNV.,4 

CALL 

•FFIL. 

GOOD 

LXA 

NSQ  •  1 

LXA 

TWONSQ  »  2 

CLA 

LC11 

ADD 

NSQ 

STA 

ST02 

SOEZE 

CLA* 

ST01 

T  I X 

*+l *2*1 

LDO* 

FRN 

ST01 

ST02 

STO 

***1 

T  I X 

*+1*2*1 

T  I X 

SQEZE»1*1 

CLA 

IRR1 

TZE 

*  +  3 

CLA 

=  32 

TRA 

MMME 

PXA 

0,7  CHECK  OPTION  FOR  DET  PRINT 

TZE 

MMMR 

TRA 

*  +  4.7 

TRA 

PNTDET  FIELD  2  -  -3 

TRA 

MMMR  FIELD  2  «  -2 

PNTOET 

CALL 

« FWRD . ( .UN06 • .DETPNT  ) 

CLA 

MA 

TSX 

•FCNV. *4 

CLA 

NA 

TSX 

.FCNV. *4 

CLA* 

YMAA 

TSX 

.FCNV.,4 

CLA 

DET 

TSX 

.FCNV.,4 

CLA 

NDETXP 

TSX 

.FCNV.,4 

CALL 

.FFIL. 

YTL20370 

YTL20380 

YTL20390 

YTL20400 

YTL20410 

YTL20420 

YTL20430 

YTL20440 

YTL20450 

YTL20460 

YTL20470 

YTL20480 

YTL20490 

YTL20500 

YTL20510 

YTL20520 

YTU20530 

YTL20540 

YTL20580 

YTL20560 

YTL20570 

YTL20580 

YTL20590 

YTL20600 

YTL20610 

YTL20620 

YTL20630 

YTL20640 

YTL20650 

YTL20660 

YTL.20670 

YTL20680 

YTL20690 

YTL20700 

YTL20710 

YTL20720 

YTL20730 

YTL20740 

YTL20780 

YTL20760 

YTL20770 

YTL20780 

YTL20790 

YTL20800 

YTU20610 

YTL20820 

YTL20830 

YTL20840 

YTL20830 

YTL20860 

YTL20870 

YTL20880 

YTL20890 

YTL20900 

YTL20910 

YTi-20920 

YTL20930 

YTL20940 

YTU20930 

YTU20960 


TRA 

MMMR 

YTL20970 

* 

YTL209O0 

* 

YTL20990 

* 

YTL21000 

MMM19  ZET 

2.  A 

YTL21010 

TRA 

TRY  3 

YTL210Z0 

NZT 

3,4 

YTL21030 

TRA 

RDBCD 

YTL2 1 0 AO 

CLA 

=  16 

FIELD  2  OR  FIELD  3  =0 

YTL2 10^0 

TRA 

MMME 

YTL21060 

TRY 3  ZET 

3,4 

YTL21070 

TRA 

RDDECM 

YTL21060 

TRA 

*-4 

YTL21090 

RDBCD  CLA 

4,4 

FIELDS  2  AND  3  ARE  ZERO 

YTL21100 

TZE 

RDBCD 1 

READ  1  BCD  CARD 

YTL21U0 

STO 

TAPI 

YTL21120 

CALL 

• F VI 0 , ( TAPI 

,  T  API B ) 

YTL21130 

RDBCD1  CALL 

•  FRDD , ( TAP  I B  »TLE IN ) 

YTL21140 

CLA 

YMAA 

YTL211S0 

STA 

IN+3 

YTL21160 

IN  CALL 

•FSLI .!**«= 

14) 

YTL21170 

CALL 

•  FRTN  » 

YTL21180 

TRA 

DONE 

YTL211VO 

RDDECM  CLA 

4,4 

YTL21200 

TNZ 

*  +  2 

YTL21210 

CLA 

TAP 

CURRENT  TAPE 

YTL21220 

STO 

READ+7 

YTL21230 

SUB 

=  5 

YTL21240 

TZE 

GOODTP 

TAPE  5  IS  PERMITTED 

YTL212S0 

CLA 

READ+7 

YTL21260 

STO 

TAPE 

YTL21270 

TSX 

TPCK. , 4 

CHECK  TAPE  NO, 

YTL21280 

LXD 

SPOT  4,4 

YTL21290 

GOODTP  CLA 

3,4 

YTL21300 

STO 

READ+5 

YTL21310 

CLA 

2,4 

YTL21320 

STO 

READ+4 

YTL21330 

CLA 

1,4 

YTL21340 

STO 

READ1+3 

YTL213S0 

REA01  CALL 

K.RD (**,«!  ,  IRROR»KRDP4,KRDP5*»0»K.RDP7) 

YTL21360 

STO 

TEMP 

CARD  COUNT 

YTL21370 

CLA 

IRROR 

YTL21360 

TZE 

CK19NL-2 

YTL21390 

XCA 

YTL21400 

MPY 

THOUSN 

YTL21410 

XCA 

YTL21420 

ADO 

TEMP 

YTL21430 

ADD 

MILYN 

YTL2144Q 

TRA 

MMME 

YTL214S0 

NZT* 

READ1+3 

YTL21460 

STZ* 

READ1+3 

YTL21470 

CK.19NL  CLA* 

L  A 1 1 

YTL21480 

SUB 

WDMNL 

ARE  WE  READING  IN  TO  A  NULL  MATRIX 

YTL21490 

TNZ 

DONE 

IF  NOT,  ALLDONE 

YTL21500 

LDO* 

MMMA 

YTL21510 

MPY* 

MMNA 

YTL21520 

XCA 

YTL21530 

SUB 

=  1 

M*N-1 

YTL21540 

PAX 

0,1 

YTL215SO 

ADD 

*1 

YTL21560 
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ADO 

LAI  1 

LA11+M*N 

YTL21570 

STA 

*  +  l 

YTL21580 

CLA 

**.l 

YTL21590 

TN2 

CLRWRD 

IF  NON-ZERO  ELEMENT.  CLEAR  CODE  WORD 

YTL21600 

T  IX 

*-2.1 #1 

YTL21610 

TRA 

DONE 

YTL21620 

CLRWRD 

STZ* 

LAI  1 

CLEAR  CODE  WORD 

YTL21630 

TRA 

DONE 

YTL21640 

REM 

YTL21630 

# 

MMM20  -  OUTPUT  ROUTINE  FOR  YTLOl 

YTL21660 

# 

CONVERTED  TO 

FORTRAN  METHOD  IN  JUNE  1962 

YTL21670 

# 

NEEDS  (STH). 

(FIL).  ( TSH) .  (RTN) 

YTL216B0 

* 

INSTRUCTION  CARD  IS.  FIELD  1  «  LOCATION  OF  MATRIX 

YTL21690 

* 

=  0  IF  COMMENT  IS  TO  BE 

YTL21700 

* 

PRINTED  ON  LINE  -  WORKS 

YTL21710 

* 

WITH  CORE  OR  TAPE  COMMENTYTL2 1720 

# 

FIELD  2=0.  FOR  NEW  PAGE 

YTL217J0 

# 

«  1  FOR  NO  SPACING 

YTL21740 

# 

FIELD  3  =  0  TO  PRINT  MATR IX. CHKSUM 

YTL21750 

« 

=  1  FOR  CHECKSUM  ONLY 

YTL21760 

# 

FIELD  4  *=  0.  IF  MATRIX  NO.  WANTED 

YTL21770 

* 

=  K.  IF  1  FULL  TITLE  CARD 

YTL21780 

» 

TO  BE  READ  FROM  TAPE  K 

YTL217Y0 

# 

*  8000  OR  GREATER  THE 

YTL21800 

* 

COMMENT  COMES  FROM  CORE 

YTL21810 

# 

THIS  IS  CONNECTED  WITH 

YTL21820 

# 

NEW  OPTION  IN  OP.  CODE  19YTL21830 

* 

FIELD  5  =  OP.  CODE  20 

YTL21840 

* 

MMM23A-ENTRY 

POINT  TO  ALLOW  MMM23  TO  UTILIZE  THE 

YTL218&0 

# 

MATRIX 

IDENTIFICATION  SECTION  OF  MMM20 

YTL21860 

* 

FIRST  PAGE  HEADING  AND  NEW  PAGE  PRINT  ARE 

YTL21870 

# 

USED  BY  MMM23 

ALSO 

YTL21880 

MMM23A 

CLA 

=  1 

MAP  ROUTINE  WAS  CALLED 

YTL218VO 

STO 

MAP 

YTL21900 

TRA 

MMM20+1 

YTL21910 

MMM20 

STZ 

MAP 

YTL21920 

NZT 

1.4 

IS  THIS  AN  ON  LINE  COMMENT 

YTL21930 

TRA 

NSPACE 

YES.  DO  NOT  CHECK  DIMENSIONS 

YTL21940 

CLA 

MA 

YTL219&0 

ADD 

NA 

YTL  2  I960 

TZE 

*  +  2 

YTL21970 

TSX 

CKDM1 .4 

CHECK  DIMENSIONS  IN  FIELD  1 

YTL219B0 

CLA 

YMB6 

YTL21990 

STO 

SPACE 

IS  FIELD  2  BLANK 

YTL22000 

TNZ 

NSPACE 

YTL22010 

CALL 

•FWRD. ( »UN06. . NPAGE ) 

YTL220Z0 

CALL 

»FF I L • 

YTL22030 

N  SPACE 

CLA 

YMNC 

YTL22040 

STO 

TTLE 

YTL22050 

TZE 

PNTNO 

IS  FIELD  4  BLANK 

YTL22060 

CAS 

=  22 

IS  IT  A  TAPE  NO. 

YTL22070 

TRA 

*  +  3 

NO 

YTL22080 

TRA 

TPTLE 

YES 

YTL22090 

TRA 

TPTLE 

YES 

YTL22100 

AXT 

14.1 

CORE  TITLE.  COPY  INTO  TITLE 

YTL22U0 

ADD 

=  14 

YTL22120 

ADD 

YSHIFT 

YTL22130 

STA 

*  +  l 

YTL22140 

CLA 

**.l 

YTL221&0 

STO 

TITLE+14.1 

YTL22160 
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T  I X 
TRA 

TPTLE  CALL 
CALL 
CALL 
CALL 

PNTTLE  CLA 

TNZ 

CALL 

CALL 

CALL 

TRA 

WRTCMT  CALL 
CALL 
CALL 
CLA 
STO 
TRA 

PNTNO  CLA 
STO 
NZT 
TRA 
CLA 
ADD 
TNZ 
ZET 
TRA 

NOTITL  CLA 
TRA 

PRNTFL  CALL 
CLA* 
TSX 
CALL 

CKSM  LDO 
MPY 
XCA 
PAX 
ADD 
PAX 
ADD 
STA 
PXA 
ACL 
T  I X 
SLW 
CALL 
CLA 
TSX 
CLA 
TSX 
CLA 
TSX 
CALL 
CLA 
TZE 
CALL 
CALL 
NZT 
TRA 

ANN20  ZET 


*-2*1.1 

PNTTLE 

.FVIO. (YMNC.TAP1IB) 
.FRDD.(TAPIIB.TLEIN) 

•  FSLI  •  (TITLE*=14) 

•FRTN# 

YMAA  CHECK  FOR  ON  LINE  PRINT 

WRTCMT 

•FPRN. (TLEOUT ) 

.FSL0.(TITLE.-14) 

.ff IL. 

DONE 

.FWRD.(.UN06.*TLEOUT) 

.FSLO. (TITLE. -14) 

•FF I L • 

■14 
LINE 
PNTNO+2 
=  12 
LINE 
YMAA 
NOTITL 
MA 
NA 

PRNTFL 
TTLE 
DONE 
=  7 

MMME 

.FWRD. I .UN06. *MATNO> 

YMAA 

.fCNV,  .4 

•  FFIL  * 

MA 
NA 


LINE 

1  OF 

ROW 

1 

STARTS 

ON  LINE 

14 

LINE 

1  OF 

ROW 

1 

STARTS 

ON  LINE 

12 

GO  AHEAD  AND  PRINT  IF  M  OR  N  IS  NON-ZERO 
DIMENSIONS  ARE  ZERO.  WAS  A  TITLE  PRINTED 
YES*  0  DIMENSIONS  HERE  CAUSE  AN  EXIT 

NO. THEY  ARE  TRYING  TO  PRINT  A  0  BY  0  MATR 


LOAD  INDEX  FOR  FORMAT  CHECK 


COMPUTE  CHECK  SUM  OF  MATRIX 


0.2 
■3 
0.1 
YMAA 
*  +  2 
0.0 
**.l 
*-1.1.1 
CHKSUM 

.FWRD. ( .UN06..0RDSUM) 

MA 

.FCNV . .4 
NA 

.FCNV. .4 
CHKSUM 
.FCNV. .4 
.FFIL. 

ANULL 

ANN20 

.FWRD. ( .UN06. .NULMAT ) 

.FFIL. 

MAP 

OUT 20  NOT  MAP 

MAp  WAS  MAPPING  CALLED 


YTL2Z170 
YTL22  1 1>  0 
YTL22190 
YTL22200 
YTL22210 
YTL22220 
YTL22230 
YTL222A0 
YTL222P0 
YTL222&0 
YTL22270 
YTL22200 
YTL22290 
YTL22300 
YTL22310 
YTL22320 
YTL22330 
YTL22340 
YTL22330 
YTL-22360 
YTL22370 
YTL22360 
YTL22390 
YTL22400 
YTL22410 
YTL22420 
YTL22430 
YTL22440 
IXYTL22430 
YTL22460 
YTL22470 
YTL224B0 
YTL22490 
YTL22500 
YTL22510 
YTL22520 
YTL22530 
YTL22540 
YTL22550 
YTL22560 
YTL22570 
YTL225B0 
YTL22590 
YTL22600 
YTL22610 
YTL22620 
YTL22630 
YTL2264Q 
YTL22630 
YTL226P0 
YTL22670 
YTL226B0 
YTL22690 
YTL22700 
YTL227 10 
YTL227Z0 
YTL22730 
YTL22740 
YTL22730 
YTL22760 
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TRA 

MMM23 

YES 

YTL22770 

ZET 

YMCC 

IS  ONLY  CHECK  SUM  WANTED 

YTL227B0 

TRA 

CSMOLY 

YES 

YTL22790 

PXA 

0.2 

NO 

YTL22800 

ADD 

LA  11 

YTL22810 

STA 

FMTCK 

YTL22820 

AXT 

0.1 

YTL22830 

FMTCK 

CLA 

**  *  2 

EXAMINE  MATRIX  TO  FIND  1 

YTL22840 

TNZ 

*+2 

YTL22830 

TXI 

*+3.1.1 

YTL22860 

ANA 

■0377400000000  FLOATING  POINT  ELEMENT 

YTL22870 

TNZ 

FLPPT 

IF  FL.  PT  .  USE  E  FORMAT 

YTL22880 

T  IX 

FMTCK. 2.1 

YTL22890 

LDO 

MA 

YTL22900 

MPY 

NA 

YTL22910 

XCA 

YTL22920 

STZ 

CHKSUM 

YTL22930 

SXA 

CHKSUM.l 

YTL22940 

SUB 

CHKSUM 

YTL22950 

TZE 

FLPPT 

YTL22960 

STZ 

WHCHFT 

0  IF  INTEGER  FORMAT 

YTL22970 

TRA 

FMTDEF 

YTL229B0 

FLPPT 

CLA 

■1 

YTL22990 

STO 

WHCHFT 

-1  IF  FLOATING  POINT  FORMAT 

YTL23000 

FMTDEF 

CLA 

■1 

YTL230 10 

STO 

I 

COUNT  OF  ROWS 

YTL23020 

CLA 

LA  1 1 

YTL23030 

STA 

PRNT 

YTL23040 

STZ 

CHKSUM 

ZERO  FOR  NEW  PAGE  TRANSFER 

YTL23050 

LOOP 

CLA 

NA 

YTL23060 

PAX 

0.2 

COLUMN  COUNT 

YTL23070 

AXT 

7.1 

START  COUNT  OF  ELEMENTS  ON  ONE 

k-INE 

YTL23080 

ADD 

PRNT 

INCREMENT  PRINT  ADDRESS  BY  1  ROW 

YTL23090 

STA 

PRNT 

YTL23100 

PRNT1 

CLA 

WHCHFT 

YTL23H0 

TZE 

FIXPRT 

YTL23120 

CALL 

•  FWRD*  <  *UN06. .FLPPNT ) 

YTL23130 

TRA 

PRNT-2 

YTL23140 

FIXPRT 

CALL 

.FWRD. ( .UN06. 

. INTPNT ) 

YTL231&0 

CLA 

I 

ROW  INDEX 

YTL23160 

TSX 

•FCNV..4 

YTL23170 

PRNT 

CLA 

**  *  2 

YTL23180 

TSX 

•FCNV..4 

YTL23190 

T  I X 

COLUMN ,2.1 

IS  THIS  ROW  FINISHED 

YTL23200 

CALL 

•FFIL. 

YTL23210 

CLA 

I 

YES.  ARE  ALL  ROW  FINISHED 

YTL23220 

CAS 

MA 

YTL23230 

TRA 

OUT20 

YTL23240 

TRA 

OUT20 

YTL23250 

ADD 

»1 

MORE  ROWS  LEFT 

YTL23260 

STO 

I 

YTL23270 

CLS 

LINE 

FIND  OUT  IF  THERE  ARE  AT  LEAST 

YTL232B0 

SUB 

■  1 

3  LINES  AVAILABLE  FOR  THIS  NEW 

ROW 

YTL23290 

ADD 

■  54 

YTL23300 

LDO 

■3 

YTL2  33 10 

TLQ 

KEPPNT 

YTL23320 

XCA 

3  OR  LESS  LINES  AVAILABLE  -  K 

YTL23330 

MPY 

■  7 

YTL23340 

XCA 

YTL233&0 

CAS 

NA 

IS  K  SUFFICIENT  TO  HOLD  1  ROW 

YTL23360 
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COLUMN 


C LOS  IT 

newpge 

COTLE 

BACK 

KEPPNT 

CSMOLY 

OUT20 

* 

* 

MMM21 


TRA 

KEPPNT 

TRA 

KEPPNT 

CLA 

« 1 

STO 

CHKSUM 

TRA 

NEWPGE 

T  I X 

PRNT  *  1 

AXT 

7.1 

CLA 

SPACE 

TNZ 

PRNT 

CLA 

LINE 

ADD 

'1 

STO 

LINE 

STZ 

CHKSUM 

CLA 

LINE 

CAS 

■  54 

TRA 

CLOSIT 

TRA 

PRNT 

TRA 

PRNT 

CALL 

•FFIL* 

CLA 

TTLE 

TNZ 

CDTLE 

CALL 

. F  WRD • 

CLA* 

YMAA 

TSX 

•FCNV. 

CALL 

.FFIL. 

TRA 

BACK 

CALL 

#  FWRD • 

CALL 

•  FSLO  « 

CALL 

.FFIL. 

CLA 

=  8 

STO 

LINE 

P  X  A 

0.0 

CAS 

CHKSUM 

TRA 

STPGE 

TRA 

PRNT1 

TRA 

LOOP 

CLA 

SPACE 

TNZ 

LOOP 

CLA 

LINE 

ADD 

=  2 

STO 

LINE 

TRA 

LOOP 

CALL 

.FWRD. 1 

CALL 

.FFIL. 

TRA 

DOME 

CALL 

.FWRD. 1 

CALL 

.FFIL. 

TRA 

DONE 

PACKAGE 

diagon; 

TSX 

CKDM1 

TSX 

CKDG1 *< 

CLA 

ANULL 

TZE 

*  +  3 

CLA 

»11 

TRA 

MMME 

LDQ 

MA 

STO 

MC 

MPY 

NA 

NOT  ENOUGH  # START  NEW  PAGE 
STILL  PRINTING  ROW  I  *  SAME  LINE 
START  COUNT  OF  ELEMENTS  IN  A  LINE 
ARE  WE  SUPPRESSING  NEW  PAGES 
IGNORE  LINE  COUNT  IF  SPACE  NOT  ZERO 
START  NEW  LINE 


ZERO  CONTROL  FOR  NEW  eAGE  TRANSFER 
ARE  WE  ABOUT  TO  PRINT  LINE  55 


WHICH  TITLE  TO  PRINT 


RESET  LINE  COUNT 


RETURN  TO  MMM23 

PRINT  ROW  INDEX  AT  START  OF  PAGE 
NEW  ROW  AT  START  OF  PAGE 

DO  NOT  INCREMENT  COUNT  IF  SPACING  IGNORED 
START  NEW  ROW  ON  CURRENT  PAGE 


12  MMM21 
.  INVERSE 


NULL  MATRIX  WILL  NOT  INVERT 


XCA 


YTL23370 

YTL23380 

YTL23390 

YTL23400 

YTL23410 

YTL23420 

YTL23430 

YTL23440 

YTL23450 

YTL23460 

YTL23470 

YTL23480 

YTL23490 

YTL23500 

YTL23510 

YTL23520 

YTL23530 

YTL23540 

YTL23550 

YTL23560 

YTL23570 

YTL23580 

YTL23590 

YTL23600 

YTL23610 

YTL23620 

YTL23630 

YTL236A0 

YTL23650 

YTL23660 

YTL23670 

YTL23680 

YTL23690 

YTL23700 

YTL23710 

YTL23720 

YTL23730 

YTL237A0 

YTL23750 

YTL23760 

YTL23770 

YTL23780 

YTL23790 

YTL23800 

YTL23810 

YTL238Z0 

YTL23830 

YTL238A0 

YTL23850 

YTL23860 

YTL23870 

YTL23880 

YTL23890 

YTL2390O 

YTL23910 

YTL23920 

YTL23930 

YTL239A0 

YTL23950 

YTL2396Q 


200 


CORE 


MMM22 


OUTR 

MIDL 
I NNR 


PAX  0*1 

ADD  LA  1 1 

STA  CORE+1 

SUB  LA1X 

ADD  LC1 1 

STA  CORE+2 

CLA  NA 

STO  NC 

TSX  CHKCOR  •  4 

CLA  “1*0 

FDP  **.l 

STQ  **»1 

T I X  CORE* 1*1 

DCT 

TRA  *  +  2 

TRA  MMMR 

CLA  ”10 

TRA  MMME 

PACKAGE  13  MMM22 
FORM  PI  MATRIX 

TSX  CKDM12  * A  CHECK  DIMENSIONS  IN  FIELDS  1*2 

2ET  ANULL 

ST2*  LA  1 1  A  IS  NULL 

ZET  BNULL 

STZ*  LB  1 1  B  IS  NULL 

CLA  =25 

STO  NC 

LDQ  ma 

MPY  NA 

XC  A 

STO  MC 

TSX  CHKCOR  * A 

CLA  MC 

PAX  0*4 

ADD  LA  1 1 

STA  INNR+6 

SUB  LA  1 1 

ADD  LB  1 1 

STA  INNR+2 

CLA  LC11 

STA  I NNR 

LDQ  NB 

MPY  MB 

XCA 

SUB  MC 

TZE  OUTR 

TRA  MMMCF 

AXT  25*2 

CAL  I NNR 

ACL  =25 

SLW  INNR 

CLA  =1.0 

AXT  5*1 

STO  CELL1 

STO  **  *  2 

XCA 

FMP  **.4 

TXI  *+l,2.-l 

T I X  INNR* 1.1 

LDQ  CELL1 


YTL23970 
YTL23980 
YTL23990 
YTLZ4000 
YIL/'.Ol'i 
YtL/40'0 
YTL24030 
YTL24040 
YTL240&0 
YTL24060 
YTL24070 
YTL24080 
YTL24090 
YTL24100 
YTL24110 
YTL24120 
YTL24130 
YTL24140 
YTL24150 
YTL24160 
YTL24170 
YTL24180 
YTL24190 
YTL24200 
YTL24210 
YTL24220 
YTL24230 
YTL24240 
YTL24250 
YTL24260 
YTL242  70 
YTL242U0 
YTL24290 
YTL24300 
YTL24310 
YTL24320 
YTL24330 
YTL24340 
YTL24350 
YTL24360 
YTL24370 
YTL24380 
YTL24390 
YTL24400 
YTL24410 
YTL24420 
YTL24430 
YTL24440 
YTL24450 
YTL24460 
YTL24470 
YTL244B0 
YTL24490 
YTL24500 
YTL24510 
YTL24520 
YTL24530 
YTL24540 
YTL24550 
YTL24560 


# 

* 

* 

# 

* 

* 

* 

* 

* 

* 

# 

# 

* 


FMP 

T  IX 

T  I X 

CLA 

ZET 

STO* 

ZET 

STO* 

TRA 


**  »  4 

M I DL  *2*0 
OUTR  »4  *  1 
WDMNL 
ANULL 
LA  1 1 
BNULL 
LB11 
MMMR 
MMM23 
ADDED 
NEEDS 


-  MATRIX  MAPP 
TO  YTL01  JUNE 
(STH)  ♦  '  (FID  ♦ 


ING  OR  CHECKSUM  ROUTINE 
1962 


INSTRUCTION  CARD  IS 


AND  MMM20 
,  FIELD  1 


ZET 

PICK  UP 
MARKED  1 
ANULL 

TRA 

THRU 

NZT 

YMCC 

TRA 

STOZE 

CLA* 

YMCC 

SSP 

STO 

LEVEL 

TRA 

*  +  2 

STZ 

LEVEL 

CALL 

•FWRD. ( 

CLA 

LEVEL 

TSX 

• FCNV . » 

CALL 

.  FF  I  L  • 

CLA 

LINE 

ADD 

=  2 

STO 

LINE 

STZ 

SVCLPT 

STZ 

NCLPT 

CLA 

-110 

LDQ 

NA 

TLQ 

*♦3 

CLA 

=  34 

TRA 

MMME 

CLA 

=  9 

TLQ 

LESS10 

XCA 

SUB 

=  10 

AXT 

1.1 

SUB 

=  10 

TMI 

*+2 

TXI 

*-2.1.1 

PXA 

0.1 

PAX 

0.2 

LOCATION  OF  MATRIX 
FIELD  2=0  FOR  NEW  PAGE 

e  1  FOR  NO  SPACING 
FIELD  3  =  ADDRESS  OF  NUMBER  FOR 
ZERO  LEVEL  CHECK  I NG- 
Al  I  .J)  MAPPED  AS  ZERO  IF 
LESS  THAN  OR  EQUAL  TO 
THIS  NUMBER. 

FIELD  4  =  0  IF  MATRIX  NO.  WANTED 
=  K  IF  1  FULL  TITLE 
CARD  TO  BE  READ 
FROM  TAPE  K 
FIELD  5  =  OP.  CODE  23 
NUMBER  OF  VARIABLES  FROM  MMM20  WHICH  ARE 
ASTRISK  IN  COL  73 

A  IS  NULL 


STORE  NUMBER  FOR  ZERO  LEVEL  TESTING 


i  .LVLPT ) 


INCREASE  LINE  COUNT  FOR  EXTRA  TITLE 


ZERO  COUNT  FOR  COLUMN  I.D.  COUNT 
ZERO  FLAG  FOR  NEW  PAGE  COLUMN  I.D. 
GO  AHEAD  WITH  MAPPING 


TOO  BIG  TO  MAP 

NO.  PROCEED  WITH  MAPPING 
LESS  THAN  10  COLUMNS 
MORE  THAN  10  COLUMNS 

FIND  NUMBER  OF  COLUMN  LABELS  -  uABEL 
TO  GO  AT  EACH  INCREMENT  OF  10  COLUMNS 

IF  N  -  K* 10  ■  0.  IT  WILL  BE  +  0 
COUNT  OF  LABELS  LEFT  IN  XR1 


YTL24570 

YTL245B0 

YTL24590 

YTL24600 

YTL24610 

YTL24620 

YTL24630 

YTL24640 

YTL246B0 

YTL24660 

YTL24670 

YTL24680 

YTL24690 

YTL24700 

YTL24710 

YTL24720 

YTL247  30 

YTL24740 

YTL247&0 

YTL24760 

YTL24770 

YTL24780 

YTL24790 

YTL24800 

YTL24810 

<TL24820 

YTL24830 

YTL24840 

YTL24830 

YTL24860 

YTL24870 

YTL248B0 

YTL24890 

YTL24900 

YTL24910 

YTL24920 

YTL24930 

Y  T  L  24940 

YTL24930 

YTL24960 

YTL24970 

YTL249BO 

YTL24990 

YT  L  25000 

YTL25010 

YTL25020 

YTL25030 

YTL25040 

YTL25030 

YTL25060 

YTL2S070 

YTL25080 

YTL25090 

YTL25100 

YTL25110 

YTL25120 

YTL25130 

YTL25140 

YTL251&0 

YTL25160 


202 


STO 

SVCLPT 

SAVE  COUNT  OF  LABELS 

CLPT  CALL 

• FWRD • ( .UN06. »COLPT > 

PXA 

0*0 

PP1  ADD 

=  10 

PAX 

0.5 

TSX 

•  FCNV  •  *4 

PRINT  LABEL  ON  EACH  10  COLUMNS 

PXA 

0.5 

T  I X 

PP1.1  .1 

CALL 

.FFIL. 

CALL 

.FWRD. ( .UN06. .COLPT1 )  PRINT  TO  IDENTIFY  COLS 

CLA 

=0200000000000 

TSX 

.FCNV. .4 

TIX 

*-2.2.1 

CALL 

.FFIL. 

CLA 

NCLPT 

IS  THIS  THE  FIRST  PAGE 

TNZ 

NSPCE-2 

NO.  THIS  WAS  PRINT  ON  NEW  PAGE 

LESSIO  CLA 

=  10 

STO 

TESTI 

COUNT  FOR  IDENTIFYING  EVERY  10  TH  ROW 

CLA 

=  1 

STO 

I 

ROW  COUNT 

CLA 

LA  1 1 

ADDRESS  OF  MATRIX  - 

STA 

TESTI J 

CLA 

•-1 

STO 

CHK.SUM 

SET  UP  RETURN  FROM  MMM20  NEW  PAGE  PRINT 

MRROWS  CLA 

NA 

PAX 

0.1 

NUMBER  OF  COLUMNS 

ADD 

TESTI J 

INCREMENT  ADDRESS  OF  CURRENT  ROW 

STA 

TESTI J 

CLA 

=0606060606060 

AXT 

19.2 

STO 

ROW+19.2 

FILL  1  ROW  OF  MAP  WITH  BLANKS 

TIX 

*-1.2.1 

PXA 

ROW  .0 

CLA 

*-l 

STA 

RWCELL 

SET  UP  ADDRESS  OF  1  ST  CELL  OF  ROW 

AXT 

6.2 

CAL 

ZERO+6.2 

RWCELL  ANS 

** 

ZERO  CURRENT  COLUMN  POSITION 

TEST  I J  CLA 

**.l 

SSP 

CAS 

LEVEL 

IS  ELEMENT  (I.J)  GREATER  THAN  GIVEN  LEVEL 

TRA 

*  +  3 

YES 

TRA 

NCHNG 

EQUAL 

TRA 

NCHNG 

LESS  THAN 

CAL 

DOLSGN+6.2 

GREATER  THAN  LEVEL 

ORS* 

RWCELL 

PUT  S  IN  CURRENT  POSITION 

TRA 

*+3 

NCHN6  CAL 

POINT+6.2 

PUT  DECIMAL  POINT  IN  IF  NO.  IS  BELOW  LEVEL 

ORS* 

RWCELL 

TIX 

KPGONG .1.1 

CLA 

SPACE 

TNZ 

NSPCE 

CLA 

LINE 

CAS 

•  54 

TRA 

NEWPGE 

TO  MMM20 

TRA 

*  +  l 

ADD 

-1 

STO 

LINE 

TRA 

NSPCE 

KPGONG  TIX 

RWCELL-1 .2.1 

HAVE  WE  USED  A  FULL  CELL  OF  ROW 

YTL25170 

YTL25180 

YTL25190 

YTL25200 

YTL25210 

YTL25220 

YTL25230 

YTL25240 

YTL252S0 

.YTL25260 

YTL25270 

YTL25280 

YTL25290 

YTL25300 

YTL25310 

YTL25320 

YTL25330 

YTL25340 

YTL25350 

YTL25360 

YTL25370 

YTL25380 

YTL25390 

YTL25400 

YTL25410 

YTL25420 

YTL25430 

YTL25440 

YTL25450 

YTL25460 

YU-25470 

YTL254U0 

YTL25490 

YTL25500 

YTL25510 

YTL25520 

YTL25530 

YTU25540 

YTL25550 

YTL25560 

YTL25570 

YTL25580 

YTL25590 

YTL25600 

YTL25610 

YTL25620 

YTL25630 

YTL25640 

YTL25630 

YTL25660 

YTL25670 

YTL25680 

YTU25690 

YTL25700 

YTL25710 

YTL25720 

YTL25730 

YTL25740 

YTL25750 

YTL25760 
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CLA 

RWCELL 

YTL2S770 

ADD 

=  1 

YTL2S7B0 

STA 

RWCELL 

WANT  TO  USE  NEXT  CELL  OF  ROW 

YTL25790 

TRA 

RWCELL-2 

Y  T  L  2  6800 

STPGE 

NZT 

SVCLPT 

ARE  THERE  MORE  THAN  10  COLUMNS 

YTL26810 

TRA 

NO  ID 

NO 

YTL258Z0 

CLA 

=  1 

YES.  PUT  A  1  IN  FLAG 

YTL2S8J0 

STO 

NCLPT 

YTL25840 

LXA 

SVCLPT. 1 

YTL25850 

LXA 

SVCLPT. 2 

YTL25860 

TRA 

CLPT 

PRINT  NEW  PAGE  COLUMN  I.D. 

YTL25870 

NO  I  0 

CLA 

=*7 

COLUMN  I.D.  IS  NOT  NECESSARY 

YTL26860 

STO 

LINE 

YTL2S890 

TRA 

NSPCE 

YTL25900 

CLA 

=  9 

RETURN  FROM  PRINTING  COLUMN  I.D. 

YTL25910 

STO 

LINE 

YTL259Z0 

NSPCE 

CLA 

I 

YTL25930 

SUB 

TESTI 

YTL25940 

TZE 

RWIDNT 

DO  WE  PRINT  ROW  IDENTIFICATION 

YTL259&0 

CALL 

.FWRD . ( «UN06 . . 

RWPRNT ) 

YTL25960 

CALL 

.FSLO. (ROW. =19 ) 

YTL25970 

CALL 

•FFIL. 

YTL26960 

TRA 

TSTLMT 

YTL25990 

RWIDNT 

CALL 

.FWRD. ( . UN06 . . 

RWIDPT )  PRINT  ROW  WITH  IDENT. 

YTL26000 

CLA 

TESTI 

YTL26010 

TSX 

.FCNV..4 

YTL.260Z0 

CALL 

.FSLO.  (ROW. >=19) 

YTL26030 

CALL 

.FFIL. 

YTL26040 

CLA 

TESTI 

YTL260S0 

ADD 

=  10 

YT  L  2  6060 

STO 

TESTI 

YTL26070 

TSTLMT 

CLA 

I 

YTL26060 

CAS 

MA 

ARE  WE  DONE 

YTL26090 

TRA 

THRU 

YES 

YTL26100 

TRA 

THRU 

YTL26H0 

ADD 

“  1 

NO 

YTL261Z0 

STO 

I 

YTL26U0 

TRA 

MRROWS 

YTL26140 

THRU 

CALL 

•FWRD. ( .UN06..FINLPT) 

YTL261S0 

CALL 

.FFIL.  ' 

YTL261S0 

OUT 

TRA 

DONE 

YTL26170 

* 

MMM24  -  UNLOAD 

TAPE  UNIT 

YTL26180 

# 

FIELD  2  =  TAPE 

NUMBER  X  10**6 

YTL26190 

* 

NEEDS  LIBRARY 

ROUTINE  UNLOAD 

YTL26200 

MMM24 

CLA 

2.4 

YTL262 10 

ssp 

YTL26220 

TSX 

TP. 4 

GET  TAPE  NUMBER 

YTL26230 

STO 

TAPE 

YTL26240 

TSX 

TPCK.4 

IS  IT  A  VALID  NUMBER 

YTL262S0 

CALL 

UNLOAD ( TAPE) 

YTL26260 

TRA 

DONE 

YTL26270 

* 

PACKAGE  16  MMM25 

YTL26260 

# 

SQUARE  ROOT  OF 

A  DIAGONAL 

YTL26290 

MMM25 

TSX 

CKDM1  .4 

CHECK  DIMENSIONS  IN  FIELD  1 

YTL26300 

TSX 

CKDG1 .4 

YTL263  10 

CLA 

MA 

YTL263Z0 

STA 

MC 

YTL26330 

SRI 

LDQ 

NA 

YTL26340 

STO 

NC 

YTL26350 

TSX 

CHKC0R.4 

YTL26360 
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LOG 

NA 

YTL263  70 

MPY 

MA 

YTL263B0 

XCA 

PAX 

0*4 

YTL26390 

YTL26400 

STA 

SR4 

YTL26410 

ACL 

LA  1 1 

YTL26420 

STA 

SR5 

YTL26430 

PXA 

0*4 

YTL26440 

ACL 

LC11 

YTL264S0 

ZET 

ANULL 

YTL26460 

TRA 

NMPY  A  IS  NULL 

YTL26470 

STA 

SR6 

YTL26480 

SR4 

AXT 

**,1  **  IS  MN 

YTL26490 

SR5 

CLA 

**,1  **  IS  LA11+MN 

YTL26500 

STO 

SQROOT 

YTL26510 

TZE 

SR6 

YTL26520 

TPL 

*  +  3 

YTL26530 

CLA 

=12  NEGATIVE  ELEMENT 

YTL26540 

TRA 

MMME 

YTL26530 

CALL 

SORT (SQROOT) 

YTL26560 

SR6 

STO 

**,1  **  IS  LC11+MN 

YTL26570 

T  IX 

SR5  *  1  *  1 

YTL2658Q 

TTR 

MMMR 

YTL26590 

* 

MMM26  -  CALL  IN  NEW  LINK.  OF  CHAIN 

YTL26600 

* 

FIELD  1  »  TAPE  NUMBER*  MUST  BE 

YTL26610 

* 

1*2*  OR  3 

YTL26620 

# 

FIELD  4  *  LINK  NUMBER 

YTL26630 

MMM26 

TRA 

DONE 

YTLZtS^O 

* 

# 

OPERATION  CODE  27  -  FIXED  POINT  INCREMENT 

YTL26630 

YTL26660 

# 

OR  DECREMENT  OF  A  SINGLE  CORE  LOCATION 

YTL26670 

* 

OR  IN  A  CORE  PROGRAM  IT  CAN  BE 

1000  +  101  +  J*  WHERE  I  IS  THE  NUMBER 

OF  CARDS  FORWARD  OR  BACKWARDS  FROM 

THIS  INSTRUCTION*  AND  J  IS  THE 

FIELD  WITHIN  THE  INSTRUCT I ON . I F 

NEGATIVE*  COUNT  IS  BACKWARDS. 

FIELD  1  *  CORE  LOCATION  TO  BE  I NCREM. /DECREM. 

YTL266B0 

YTL26690 

YTL26700 

YTL26710 

YTL26720 

YTL26730 

YTL26740 

* 

FIELD  2  BLANK  IF  FIELD  4  IS  THE  INCREMENT 

YTL26730 

* 

FIELD  2  NON-2.ERO  IF  FIELD  4  IS  THE  INCREMENT  LOCATION 

YTL26760 

# 

FIELD  3  BLANK  IF  RESULT  GOES  INTO  FIELD  1  LOCATION 

YTL26770 

* 

OTHERWISE*  RESULT  GOES  INTO  LOCATION  OF  FIELD  3 

YTL26780 

* 

FIELD  4  *  NUMBER  TO  BE  ADDED  TO  CONTENTS  OF  FIELD  1 

YTL26790 

* 

OR  LOCATION  OF  NUMBER  TO  BE  ADDED 

YTL26800 

* 

FIELD  5  =  27 

YTL268  10 

* 

* 

FIELD  3  IS  NE6AT IVE (OR  CONTENTS  IS  NEGATIVE) 

YTL26820 

YTL26830 

* 

FOR  A  DECREMENT  OF  CELL  IN  FIELD  1 

YTL26840 

# 

MMM27 

CLA 

FXADD 

YTL26830 

YTL26860 

SLW 

ADDSUB 

YTL26870 

STRT27 

CLA 

YMAA 

YTL26880 

TSX 

CHKRNG.4 

YTL26890 

TRA 

ZROER 

YTL26900 

TRA 

CORLOC 

YTL26910 

TSX 

RELADR  *4 

YTL26920 

STO 

YMAA 

YTL26930 

CORLOC 

CLA 

YMCC 

YTL26940 

TZE 

NOCHK3 

YTL269&0 

TSX 

CHKRNG*4 

YTL2696Q 
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TRA 

TRA 

TSX 

STO 

NOCHK3  CLA 
TNZ 
CLA 
CAS 
TRA 
TRA 
TRA 
CLA 
ADD 
STO 
CLA* 
TRA 

USEFLD  CLA 

ADDSUB  PZE 
ADD* 
ZET 
TRA 
STO* 
TRA 
STO* 
TRA 

RELADR  STO 
CLA 
TNZ 
CLA 
TRA 
CLA 
SSP 
SUB 
XCA 
ZAC 
DVP 
CAS 
TRA 
TRA 
STO 
MPY 
STQ 
CLA 
TMI 
CLA 
SUB 
ADD 
TRA 

BACKSK  CLA 
ADD 
SUB 
SSM 

FINDCL  ADD 
TRA 

FLDERR  CLA 
TRA 


* 


ZROER 

NOCHK3 

RELADR  *4 

YMCC 

YMBB 

USEFLD 

YMNC 

PROGLO 

*  +  3 

*  +  2 

USEFLD 
YMNC 
YSHIFT 
YMNC 
YMNC 
*  +  2 
YMNC 
0 

YMAA 

YMCC 

*  +  3 
YMAA 
DONE 
YMCC 
DONE 
SAVEF 
KEY 

*  +  3 
=  24 
MMME 
SAVEF 

TOPPOS 


=  10 
=  6 

FLDERR 
*  +  l 

FLDSKP 
=  6 

CELSKP 
SAVEF 
BACKSK 
CELSKP 
=  7 

FLDSKP 
FINDCL 
CELSKP 
=  7 

FLDSKP 

INST 
1*4 
=  33 
MMME 

OPERATION  CODE  28  -  MERGE  OF  MATRIX  A 
AND  MATRIX  A+l 


YTL26970 
YTL26980 
YTL26990 
YTL27000 
YTL27010 
YTL27020 
YTL27030 
YTL27040 
YTL270S0 
YTL27060 
YTL27070 
YTL270B0 
YTL270Y0 
YTL  27 1 00 
YTL271 10 
YTL27120 
YTL27130 
YTL27140 
YTL271S0 
YTL27160 
YTL27170 
YTL27180 
YTL27190 
YTL27200 
YTL272  10 
YTL27220 
YTL27230 
YTL27240 
YTL272R0 
YTL27260 
YTL27270 
YTL272BO 
YTL27290 
YTL27300 
YTL27310 
YTL27320 
YTL27330 
YTL27340 
YTL273RC 
YTL2736C 
YTL27370 
YTL273B0 
YTL27390 
YTL27400 
YTL27410 
YTL27420 
YTL27430 
YTL27440 
YTL274S0 
YTL27460 
YTL27470 
YTL27480 
YTL27490 
YTL27S00 
YTL27510 
YTL27520 
YTL275J0 
YTL27S40 
YTL275R0 
YTL27560 
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* 

YTL27570 

* 

YTL27580 

# 

FIELD  1  ^POSITION  NUMBER  N.  MATRIX  IN 

YTL275Y0 

# 

POSITION 

N+l  MERGED  WITH  MATRIX  IN  POSITION 

Y  T  L  27600 

* 

N.  RESULTING  MATRIX  IN  POSITION  N 

YTL27610 

# 

YTL276Z0 

# 

FIELD  2  =BLANK 

YTL27630 

# 

YTL27640 

# 

FIELD  3  *  BLANK. 

YTL276S0 

* 

YTL27660 

* 

FIELD  4  »  MAME  OF  MERGED  MATRIX 

YTL27670 

* 

YTL276O0 

* 

FIELD  5  «  28 

YTL27690 

» 

YTL27700 

MMM28 

LDQ 

MA 

YTL27710 

MPY 

NA 

YTL277Z0 

XCA 

YTL27730 

ADD 

LAI1 

YTL277A0 

ADD 

=  1 

LIMB) 

YTL27730 

STA 

GETMB 

YTL27760 

ADD 

=  1 

L  ( NB ) 

YTL27770 

STA 

GETNB 

YTL27780 

GETNB 

CLA 

** 

NB 

YTL277Y0 

STO 

NB 

YTL27800 

SUB 

NA 

YTL278 10 

TNZ 

mmmcf 

COLUMN  NUMBERS  INCOMPATIBLE 

YTL27820 

GETMB 

CLA 

«• 

MB 

YTL27830 

STO 

MB 

YTL27840 

ADD 

MA 

YTL27830 

STO* 

MMMA 

NEW  NUMBER  OF  ROWS 

YTL27860 

XCA 

YTL27870 

MPY 

NA 

YTL27880 

XCA 

YTL27890 

ADD 

LA  1 1 

YTL27900 

STA 

STMA 

YTL27910 

TSX 

CKDM12  #4 

YTL279Z0 

LDQ* 

GETNB 

YTL27930 

MPY* 

GETMB 

YTL27940 

XCA 

YTL27930 

PAX 

0*1 

NUMBER  OF  WORDS  TO  MOVE 

YTL27960 

ADD 

GETNB 

YTL279  70 

ADD 

=  1 

YTL27980 

STA 

LDMB 

YTL27990 

CLA 

GETNB 

YTL28000 

ADD 

=  1 

YTL28010 

STA 

*  +  l 

YTL280^0 

CLA 

*# 

LB1 1 

YTL28030 

SUB 

WDMNL 

IS  POSITION  N  +  l  NULL 

YTL280A0 

TNZ 

*  +  3 

NO 

YTL28030 

STZ* 

*-3 

CLEAR  OUT  CODE  WORD 

YTL28060 

TRA 

LDMB 

YTL28070 

CLA 

ANULL 

IS  POSITION  N  NULL,  N+l  NOT 

NULl 

YTL28080 

TZE 

LDMB 

NO 

YTL28090 

STZ* 

LAI  1 

CLEAR  CODE  WORD  WHEN  POS.  N 

NULl, 

N+l  NOT  NYTL28100 

LDMB 

CLA 

**»1 

LB1 1+MB*NB 

YTL28110 

STMA 

STO 

Q*  *  1 

LAI 1+ ( MA+MB ) *NA 

YTL281Z0 

T  IX 

LDMB *1*1 

YTL28130 

AXT 

3*1 

YTL28140 

STZ* 

LDMB 

YTL28160 

T  1 X 

*-1*1*1 

YTL28160 
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CLA 

YMNC 

YTL28170 

STO* 

YMAA 

YTL281B0 

* 

TRA 

DONE 

YTL28190 

YTL28200 

* 

* 

MMM29-CLEAR  CORE 

YTL28210 

YTL28220 

* 

FIELD  1  IS  THE  STARTING  ADDRESS  OF  CLEAR 

YTL28230 

* 

FIELD  4  IS  THE  NUMBER  OF  LOCATIONS 

YTL28240 

* 

IF  ZERO* CORE  IS  CLEARED  TO  32563 

YTL28280 

MMM29 

CLA 

YMAA 

YTL28260 

TSX 

CHKRNG » 4 

YTL28270 

TRA 

ZROER 

YTL28280 

TRA 

*  +  2 

YTL28290 

TSX 

RELADR  *4 

YT  L  2  8300 

ADD 

YMNC  INCREMENT, IF  ANY 

YTL28310 

CAS 

HI  CORE 

YTL28320 

TRA 

*+  3 

YTL28330 

TRA 

LIMOK 

YTL28340 

TRA 

LIMOK 

YTL28350 

SUB 

YSHIFT 

YTL28360 

CAS 

HICORE 

YTL28370 

TRA 

TEST2+3 

YTL28380 

TRA 

*+l 

YTL28390 

LIMOK 

STA 

ZROSRT 

YTL28400 

CLA 

YMNC  INCREMENT 

YTL28410 

PAX 

0,1 

YTL28420 

TZE 

*  +  4 

YTL28430 

TPL 

ZROSRT 

YTL28440 

CLA 

=30  NEGATIVE  INCREMENT 

YTL28450 

TRA 

MMME 

YTL28460 

CLA 

HICORE 

YTL28470 

ADD 

*  1 

YTL28480 

STA 

ZROSRT 

YTL28490 

SUB 

YMAA 

YTL28500 

PAX 

0,1 

YTL28510 

ZROSRT 

STZ 

**»1 

YTL28520 

• 

T I X 

*-1,1,1 

YTL28530 

TRA 

DONE 

YTL28540 

Z  ROER 

CLA 

=  29 

YTL28550 

* 

TRA 

MMME 

YTL28560 

YTL28570 

* 

MMM30 , MMM3 1 »MMM32 , ARE  THE  MULTIPLY 

YTL28580 

* 

AND  ADD  ROUTINES  CORRESPONDING  TO  MMM6 , 

YTL28590 

# 

MMM7 • ANDMMM8  *  A  CHECK  IS  MADE  TO  SEE 

YTL28600 

* 

THAT  THERE  IS  A  CONFORMABLE  MATRIX  IN 

YTL28610 

* 

THE  POSITION  OF  FIELD  3  »AND  THEN  IT 

YTL28620 

* 

TRANSFERS  CONTROL  TO  MMM6»MMM7,OR 

YTL28630 

* 

MMM8.  THE  INITIALIZING  OF  THE  SUMMING 

Y  T  L  2  8640 

# 

* 

MATRIX  IS  LEFT  UP  TO  THE  USER 

YTL28630 

YTL28660 

MMM3Q 

CLA 

=  1 

YTL28670 

STO 

MAD 

YTL28680 

CLA 

MA 

YTL28690 

SUB* 

LOCMC 

YTL28700 

TZE 

*  +  3 

YTL28710 

NCNFBS 

CLA 

=31  SUMMING  MATRIX  NON-CONFORMABLE 

YTL28720 

TRA 

MMME 

YTL28730 

CLA 

NB 

YTL28740 

SUB* 

LOCNC 

YTL28750 

TN2 

NCNFBS  NON-CONFORMABLE 

YTL28760 
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CLA 

WDMNL 

SUB* 

LC11 

TNZ 

*+2 

STZ 

MAD 

TRA 

MMM6 

# 

MMM31 

CLA 

=  1 

STO 

MAD 

CLA 

MA 

SUB* 

LOCMC 

TNZ 

NCNFBS 

NON-CONFORMABLE 

CLA 

MB 

SUB* 

LOCNC 

TNZ 

NCNFBS 

NON-CONFORMABLE 

CLA 

WDMNL 

SUB* 

LC11 

TNZ 

*  +  2 

STZ 

MAD 

TRA 

MMM7 

MMM32 

CLA 

=  1 

STO 

MAD 

CLA 

NA 

SUB* 

LOCMC 

TNZ 

NCNFBS 

NON-CONFORMABLE 

CLA 

NB 

SUB* 

LOCNC 

TNZ 

NCNFBS 

NON-CONFORMABLE 

CLA 

WDMNL 

SUB* 

LC1I 

TNZ 

*  +  2 

STZ 

MAD 

TRA 

MMM8 

# 

* 

AS  MMM  27 

BUT 

SUB  IS  USED 

* 

MMM3  3 

CLA 

FXSUB 

SLW 

ADDSUB 

TRA 

STRT27 

# 

* 

* 

FOLLOWING 

ARE 

ALL  YTLOl  CONSTANTS  AND 

FORMATS 

* 

* 

THE  FOLLOWING 

IS  A  SET  OF  CELLS  THAT 

* 

ARE  SET  UP 

TO 

FACILITATE  DUMPING  IN 

* 

CHARET. 

ERRCDE 

PZE 

0 

ERROR  CODE 

BCI 

1  *  ERRCDE 

TAPE 

BSS 

3 

TAPE  NO  » ALSO  FILE*MATRIX 

SPACING 

BCI 

l.TAPE 

« 

LAST  INS 

• 

TAPE+1  • 

TAPE+2 

* 

• 

• 

* 

FSF 

.file  count  in  decr. 

0 

* 

BSF 

.FILE  COUNT  -1  IN  DECR.. 

0 

* 

FSR 

. 2*MATR I X  COUNT  IN  DECR. 

0 

* 

FSF.FSR 

. 2*M ATR I X  COUNT  IN  DECR.  FILE  COUNT  IN  DECR 

* 

SAVE 

BSS 

16 

MATRIX  ID 

MATID 

EQU 

SAVE 

YTL28770 

YTL28780 

YTL28790 

YTL28800 

YTL28810 

YTL28820 

YTL28830 

YTL288i*0 

YTL28830 

YTL28860 

YTL28870 

YTL28880 

YTL28890 

YTL28900 

YTL28910 

YTL28920 

YTL28930 

YTL28990 

YTL289&0 

YTL28960 

YTL28970 

YTL28980 

YTL28990 

YTL29000 

YTL29010 

YTL29020 

YTL29030 

YTL290A0 

YTL290&0 

YTL29060 

YTL29070 

YTL29080 

YTL29090 

YTL29100 

YTL29110 

YTL29U0 

YTL29130 

YTL29X40 

YTL29180 

YTL29160 

YTL29170 

YTL29180 

YTL29190 

YTL29200 

YTL29210 

YTL29220 

YTL29230 

YTL292A0 

YTL29230 

YTL29260 

YTL29270 

YTL29280 

YTL29290 

YTL29300 

YTL29310 

YTL293^0 

YTL29330 

YTL293A0 

YTL293&0 

YTL29360 
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BCI 

l.MATID 

KEY 

PZE 

CORPRG 

EQU 

KEY 

BCI 

l«CORPRG 

* 

THESE  ARE 

PHYSCT 

PZE 

0 

I NSCNT 

PZE 

0 

XMODE 

PZE 

INST 

PZE 

S AVKEY 

PZE 

mcroct 

PZE 

RETURN 

BSS 

5 

PRGLOC 

BSS 

5 

MA 

NA 

LAI  X 

MB 

NB 

LB11 

MC 

NC 


IR1 

IR2 


PZE 

PIE 


■  w  n  i  i  *  » *  *  f  * r  1  9  w  w 

PHYSICAL  COUNT  OF  INSTRUCTIONS 
COUNT  OF  EXECUTED  INSTRUCTIONS 
PARTITION  ADDRESS 

ADDRESS  OF  NEXT  CORE  EXECUTED  INSTRUCTION 


PARAMETERS 


LC  1 1 
TEMPAC 

PZE 

0 

T  EMPMQ 

PZE 

0 

CELLO 

PZE 

0 

* 

MISCELI 

WHCHFT 

PZE 

0 

TAP1I8 

PZE 

0 

TAP  IB 

PZE 

0 

READ 

BSS 

8 

KRDP1 

EQU 

READ+1 

KRDP4 

EQU 

READ+4 

KRDP  5 

EQU 

READ+5 

KRDP7 

EQU 

READ+7 

TAPEIB 

PZE 

0 

adrsda 

PZE 

DATA 

SEPE 

PZE 

0 

LOC 

BSS 

5 

TAP 

PZE 

0 

SQROOT 

PZE 

0 

TAPI 

PZE 

FPTTRA 

TRA 

FPSPIL 

TMPFPT 

PZE 

0 

XR  1 

PZE 

XR2 

PZE 

XR4 

PZE 

YSHIFT 

PZE 

IRROR 

PZE 

INS 

PZE 

**  *  2 

SAME  FOR  MQ 

SAVE  OF  LAST  NON-ZERO  CELL  0 
CONSTANTS 

FORMAT  INDICATOR  FOR  20 

TAPE  NUMBER  FOR  TITLE  IN  20  AND  23 

CALLING  PARAMETERS  FOR  OP.  CODE  19 

STARTING  ADDRESS 

NUMBER  4F  FIELDS 

NUMBER  OF  DIGITS  PER  FIELD 

TAPE  NO. 

TAPE  UNIT  SPECIFICATION  FOR  IOCS 

ADD.  FOR  LOWER  LIMIT  OF  AVA I  LABi_E  CORE 

TAPE  NOTFOR  LOAD  PROGRAM 

THESE  ARE  THE  5  OPERATION  FIELDS 

TAPE  UNIT  FOR  PROGRAM  CARDS 

STORAGE  FOR  MMM25 

TRA  TO  GO  INTO  CELL  8 
SAVE  CELL  FOR  LOCATION  8 
XR  STORAGE  FOR  YTL01 


RELOCATION  CONSTANT 

KRD  ERROR  CODE  FOR  ALL  KRD  CALLS 

ADDRESS  OF  ERROR  CODE  CELLS 


XR  STORAGE  FOR  MMM 


IR3 

PZE 

0 

IR4 

PZE 

IR5 

PZE 

0 

IR6 

PZE 

0 

I  R  7 

PZE 

0 

PARTON 

OCT 

777777 

FIRST 

PZE 

1 

SET  TO  ZERO  AFTER  A  PARTITION  IS  FORMED 


YTL29370 
YTL29380 
YTL29390 
YTL29400 
YTL29410 
YTL29420 
YTL29430 
YTL29440 
YT  L  294t>0 
YTL29460 
YTL29470 
YTL294S0 
YTL29490 
YTL295O0 
YTL29510 
YTL29520 
YTL29530 
YTL29540 
YTL295^0 
YTL29S60 
YTL29570 
YTL29560 
YTL29590 
YTL29600 
YT  L296 1 0 
YTL29620 
YTL29630 
YT  L  296^0 
YTL296bO 
YTL29660 
YTL29670 
YTL29680 
YTL29690 
YTL29700 
YTL297 10 
YTL29720 
YTL29730 
YTL29790 
YTL297&0 
YTL29760 
YTL29770 
YTL297B0 
YTL29790 
YTL29800 
YTL29810 
YTL29820 
YTL298  30 
YTL29890 
YTL29850 
YTL29860 
YTL29870 
YTL29880 
YTL29890 
YTL29900 
YTL29910 
YTL29920 
YTL29930 
YTL29990 
YTL299&0 
YTL29960 
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• 

PROGLO  PZE 
SMLTAP  DEC 
LOCORE  PZE 
HICORE  PZE 
TOPPOS  PZE 
MXDATA  PZE 
HIP-OG  PZE 
TSTMAC  EQU 
MXTAPS  EQU 
• 

* 

* 


CONSTANTS  FOR  VARIOUS  DIAGNOSTICS 

LOWEST  CORELOC.  FROM  CARDS  NORMALLY  8000 
1000000  SMALLEST  TAPE  NUMBER 

LOWEST  LEGAL  CORE  ADDRESS 
HIGEST  POSSIBLE  CORE  ADDRESS 
1000  LARGER  THAN  ANY  LEGAL  POSITION  NUMBER 

MAXIMUM  SIZE  OF  ANY  MATRIX 
MAXIMUM  LOAD  ADDRESS  OF  A  PROGRAM 

7999  TEST  CONSTANT  FOR  MACRO  INSTRUCTION 

19  MAXIMUM  NUMBER  OF  TAPES 

THESE  TWO  CONSTANTS  ARE  EQUATED  TO  ABOVE  ONES. 

AND  MUSTBE  PRESERVED  IF  SMLTAP » TOPPOS *  CHANGE 


THOUSN  EQU 
MILYN  EQU 

# 

SIGN  PZE 
COREND  SCI 

* 

SPOT  4 

» 

» 


TOPPOS  MUST  BE  1000  I  DEC  I MAL ) 

SMLTAP  MUST  BE  1000000 ( DEC  I MAL ) 

SET  TO  NON-ZERO  IF  32564  HAS  BEEN  STUFFED 
1  .COREND  CODE  WORD  PUT  IN  32564 

XR4  STORAGE  FOR  MMM90 

PARAMATERS  FOR  3  WORKING  MATRICES 
CELLS  FOR  READ/WRITE  BINARY  TAPE 


MTN 

PZE 

M*N 

TEST  C 

PZE 

TEMPORARY 

WDMNL 

BCI 

l.M-NULL 

SPARSE 

BCI 

1 .SPARSE 

SPMTC1 

PZE 

TEST  CELL  FOR  SPARSE  MATRIX 

* 

WDWC 

IS  THE  NUMBER  OF  ELEMENTS  AND  CONTROL 

* 

WORDS 

NEEDED  TO  WRITE  A  SPARSE  MATRIX.  NEEDED 

• 

TO  INSURE  A  MINIMUM  RECORD  ON  TAPE  OF  16  WORDS. 

WDWC 

MNP3 

PZE 

PZE 

M*N+3  +LA11 

RSCKSM 

PZE 

USED  FOR  SPARSE  CHECKSUM  TEMP 

READTP 

PZE 

TEMP  FOR  WORD  FROM  TAPE  IN  SPARSE 

ERR 

PZE 

ERROR  CODE  FOR  BSF.FSR.FSF 

* 

TEMP 

« 

BSS 

PZE 

4  TEMPORARY  STORAGE  CELLS 

3 

NULL  MATRIX  COTEMP  AC  FORFPT  ANALYSIS 

READ 


ANULL 

BNULL 

FILL5  CLA  0.1 

FILL6  CLS  0.1 

FILL7  CLA  -0 

* 

FILLO  NOP 
FILL1  FAD  0.1 
FILL2  FSB  0.1 
FILL3  FAD  0.2 
FILL4  FSB  0.2 
DOTPRD  BSS  3 


* 


TOTA  PZE  0 

TOT B  PZE  0 

I NCRMA  PZE  0 

INCRMB  PZE  0 

MADYES  FAD*  ANSWER 

MADNO  TRA  ANSWER-1 

FIL10  FAD  0.2 


FOR  MATRIX  MOVE 
FOR  MMM 1 
FOR  MMM 2 
FOR  MMM 3 
FOR  MMM4 

CELLS  USED  FOR  DOUBLE  PRECISION 
DOT  PRODUCT  -  NEED  3  TO  INSURE 
AN  EVEN  LOCATION  ALWAYS 
MA  *  NA 
MB*NB 

STORAGE  INCREMENT  FOR  A 
ST0RA6E  INCREMENT  FOR  B 
USED  FOR  MMM30 » 31.32 
USED  FOR  MMM 6 .7.8 
FOR  MMM 10 


YTL29970 

YTL29980 

YTL29990 

YTL30000 

YTL30010 

YTL30020 

YTL30030 

YTL30040 

YTL30050 

YTL30060 

YTL30070 

YTL  300&0 

YTL30090 

YTL30100 

YTL30H0 

YTL301Z0 

YTL30130 

YTL30140 

YTL30150 

YTL30160 

YTL30170 

YTL30160 

YTL30190 

YTL30200 

YTL30210 

YTL30220 

YTL30230 

YTL30240 

YTL302&0 

YTL30260 

YTL30270 

YTL30280 

YTL30290 

YTL30300 

YTL30310 

YTL30320 

YTL30330 

YTL30340 

YTL30350 

YTL30360 

YTL30370 

YTL30380 

YTL30390 

YT  L  30400 

YTL30410 

YTL304Z0 

YTL30430 

YTL30440 

YTL30450 

YTL30460 

YTL30470 

YTL30460 

YTL30490 

YTL30500 

YTL30510 

YTL305Z0 

YTL30530 

YTL30540 

YTL30550 

YTL30560 
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FILl  1 

FSB  0*2 

FOR  MMM11 

YTL30570 

* 

CONSTANT  STORAGE  FOR  MMM18 

YTL30580 

I  RR  1 

PZE 

0 

ERROR  CODE  1 

YTL30590 

IRR2 

PZE 

0 

ERROR  CODE  2 

YTL30600 

SCALE 

PZE 

0 

CELL  FOR  SCALE  FACTOR 

YTL30610 

DET 

PZE 

0 

FRACTIONAL  PART  OF  DETERMINANT 

YTL30620 

PZE 

0 

YTL30630 

NDETXP 

PZE 

0 

EXPONENT  PART  OF  DETERMINANT 

YTL30640 

NSQ 

PZE 

0 

N**2 

YTL306&0 

TWONSQ 

PZE 

0 

2*N*#2 

YTL30660 

* 

MMM20  CONSTANTS 

YTL30670 

TITLE 

BSS 

14 

TITLE  STORAGE 

YTL30680 

CHKSUM 

PZE 

0 

PRINT  CHECKSUM 

YTL30690 

LINE 

PZE 

0 

LINE  COUNT 

YTL307O0 

SPACE 

PZE 

0 

TEST  CELL  FOR  INITIAL  SPA'.ING  TO  NEW  PAGE 

YTL30710 

TTLE 

PZE 

0 

FIELD  4  INDICATOR 

YTL30720 

MAP 

PZE 

0 

TEST  CELL  FOR  MAP  ROUTINE 

YTL30730 

I 

PZE 

0 

ROW  COUNT 

YTL30740 

CELL  1 

PZE 

0 

SCRATCH  FOR  MMM22 

YTL30750 

* 

MMM23  CONSTANTS 

YTL30760 

LEVEL 

PZE 

0 

FL.PT.  NUMBER  FOR  TESTING 

YTL30770 

TEST  I 

PZE 

0 

COUNT  FOR  FINDING  EVERY  10TH  ROW 

YTL30780 

ROW 

BSS 

19 

STORAGE  FOR  1  PRINTED  ROW 

YTL307V0 

SVCLPT 

PZE 

0 

COUNT  FOR  COLUMN  ID 

YTL30600 

NCLPT 

PZE 

0 

FLAG  FOR  NEW  PAGE  COLUMN  HEADING 

YTL30810 

* 

MAP  PARAMETERS 

YTL30820 

ZERO 

OCT 

007777777777 

YTL30830 

OCT 

770077777777 

YTL30840 

OCT 

777700777777 

YTL30850 

OCT 

777777007777 

YTL30860 

OCT 

777777770077 

YTL30870 

OCT 

777777777700 

YTL30880 

DOLSGN 

OCT 

530000000000 

YTL30890 

OCT 

005300000000 

YTL30900 

OCT 

000053000000 

YTL30910 

OCT 

000000530000 

YTL30920 

OCT 

000000005300 

YTL30930 

OCT 

000000000053 

YTL30940 

POINT 

OCT 

330000000000 

YTL309&0 

OCT 

003300000000 

YTL30960 

OCT 

000033000000 

YTL30970 

OCT 

000000330000 

YTL30980 

OCT 

000000003300 

YTL30990 

OCT 

000000000033 

YTL310O0 

FLDSKP 

PZE 

0 

COUNT  OF  FIELDS  -MMM27 

YTL31010 

CELSKP 

PZE 

0 

COUNT  OF  CELLS  FOR  CARDS  TO  SKIP 

YTL31020 

SAVEF 

PZE 

0 

YTL31030 

FXSUB 

CHS 

YTL31040 

FXAOD 

TRA 

ADDSUB+1 

YTL310&0 

MAD 

PZE 

0 

TEST  CELL  FOR  MMM30*31*32 

YTL31060 

SAVINS 

PZE 

YTL31070 

* 

NON  ZERO  FOR 

30*31 *32 (OTHERWISE  0 

YTL31080 

* 

YTL31090 

* 

FORMAT  FOR  ERROR  PRINT  IN  CONTROL  SECTION 

YTL31100 

CORERR 

BCI 

8,<1H  *10X*51HUNABLE  TO  PRINT  CURRENT  CORE  PROGRAM 

YTL31H0 

BCI 

4*  -  ERROR  CODE  =  110) 

YTL31120 

ERRPNT 

BCI 

7* ( 1H1 *10X*43HAN  ERROR  HAS  OCCURRED  IN  TL-01 

YTL31130 

BCI 

7,  -  THE  CODE 

=  I10/1H0*9X*11HA  TOTAL  OF  16* 

YTL31140 

BCI 

7»60H  INSTRUCTIONS  WERE  SUCCESSFULLY  EXECUTE 

YTL31150 

BCI 

5  *  D  PRIOR  TO 

THE  ERROR. /1H  ) 

YTL31160 
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PROGER  BCI 
BCI 
BCI 
BCI 


INVFMT  BCI 
BCI 

DETPNT  BCI 
BCI 
BCI 


NPAGE  BCI 
TLEIN  BCI 

TLEOUT  BCI 
MATNO  BCI 

ORDSUM  BCI 
BCI 

NWPGE1  BCI 
BCI 

NWPGE2  BCI 
FINAL  BCI 
BCI 

INTPNT  BCI 
BCI 
BCI 

FLPPNT  BCI 
BCI 

CSMPT  BCI 
BCI 

NJLMAT  BCI 


LVLPT  BCI 
BCI 
BCI 

COLPT  BCI 
COLPTl  BCI 
RWPRNT  BCI 
RWIOPT  BCI 
INLPT  BCI 

END 


6  * ( 11X ♦ 58HTHE  ABOVE  COUNT  WAS  STARTED 

6. WITH  THE  CORE  PR-GRAM  BELOW.  /1HO* 

6 , 10X , 49HTHE  ERROR  OCCURRED  AT  PHYSICA 
5 1 L  INSTRUCTION  NUMBER  I6/IH0) 

INVERSION  FORMATS 

9»(1H1»10X»26H INVERSION  ERROR  -  CODE1  «  I5»9H  CODE2  * 
5*I5*16H  SCALE  FACTOR  »  E18.8) 

9*(1H1/1HO/1HO *4X  *  4HTHE  I3,4H  BY  I5»15H  MATRIX  NUMBER 
6 , 1 12  »  22H  HAS  A  DETERMINANT  OF  F10.7# 

6  # 1 7H  TIMES  10  TO  THE  112, 7H  POWER.) 

MMM20  FORMATS 

3 ,  ( 1H1/1H0/1H  ) 

2  » ( 13A6  * A2 ) 

4  » ( 1H  »10X»13A6*A2/1H  ) 

6  *  t  1H  » 10X  * 14HMATR  I X  NUMBER  U1/1H  ) 

6  * ( 1H  • 10X  » 6HORDER  14, 4H  BY  I4/1H0*10X 
4 , , 1 2HCHECK  SUM  =  012/1H  ) 

6, ( 1H1/1H0»10X* 14HMATRIX  NUMBER  I11/1H 
1.0/1H  ) 

5, <1H1/1HO«10X»13A6,A2/1HO/1H  ) 

6,  <1HO/1HO#10X*20HEND  OF  MATRIX  PRINT. 

2  * / 1H0 / 1H0 ) 

6,  (1H0.4X, I4,2X,6( 1 12 ,1HB,3X) , I12.1HB/ 

7,  (  123*1 HB»3X, 112*1 HB*3X»I12»1HB»3X* 

7,I12,1HB,3X,I12,1HB,3X,I12,1HB,3X,I12,1HB) ) 

6,  ( 1H0.4X, I4,2X»6( 1PE13.6,3X) ,E 13.6/1 

4,  E24.6 ,6E16«6 ) ) 

8, (1H0/1H0,10X, 2 4H REQUEST ED  CHECKSUM  ONLY./1HO 
1,/1H0) 

6  ,  (  1H  ,  10X  ,  18HTHE  MATRIX  IS  NULL) 

MKM23  FORMATS 

7»<11X,53HMATRIX  ELEMENTS  WITH  MAGNITUDE  LES 
6 ,S  THAN  OR  EQUAL  TO  1PE16.6.31H  ARE  M 

5 ,  APPED  AS  A  DECIMAL  POINT. /1H  ) 

4 ,  ( 1 H  »16X,I3,10(7X»I3) ) 

4  ,  ( 1H  ,18X»A1»10(9X,A1)> 

3  »  1 1H  , 9X , 1 8A6  ,  A2 ) 

4  ,  (  1H  *  5X  ,  I  3 , 1H+ , 1 8 A6  » A2 ) 

8 , ( 1HO/1HO , 10X , 18HEND  OF  MATRIX  MAP./1HO/1HO) 


YTL31170 

YTL31180 

YTL31190 

YTL31200 

YTL31210 

YTL31220 

YTL31230 

YTL31240 

YTL31250 

YTL31260 

YTL31270 

YTL31280 

YTL31290 

YTL31300 

YTL31310 

YTL31320 

YTL31330 

YTL31340 

YTL31350 

YTL31360 

YTL31370 

YTL31380 

YTL31390 

YTL31400 

YTL31410 

YTL31420 

YTL31430 

YTL31440 

YTL31450 

YTL31460 

YTL31470 

YTL31460 

YTL31490 

YTL31500 

YTL31510 

YTL31520 

YTL31530 

YTL31540 

YTL315&0 

YTL31560 

YTL31570 

YTL31580 

YTL31590 

YTL31600 

YTL99990 
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SUBROUTINE  INV4DS 


S I BMAP  INVERT 
* I NV4DS 


650.DECK.M94/2 

7094  DOUBLE  PRECISION  INVERSION  ROUTINE 


# 

# 

CALL  INV4DS.A.N.ERR1*ERR2.SCALE.DET.NDETXP 

* 

A 

B 

STARTING  ADDRESS  OF  MATRIX  -  MUST  BE  EVEN 

* 

N 

B 

NUMBER  OF  ROWS  ICOLUMNS)  OF  MATRIX 

* 

IF 

NEGATIVE.  PIVOT  TERMS  ARE  PRINTED 

* 

ERR  1 

B 

0 

IF  INVERSION  SUCCESSFUL 

* 

B 

1 

IF  OVERFLOW  OCCURS 

# 

B 

2 

IF  MATRIX  IS  SINGULAR 

# 

a 

3 

IF  SCALED  INVERSE  CANNOT  BE  RE-SCAlED 

* 

a 

4 

IF  ROWS  AND  COLUMNS  CANNOT  BE  RE-ARRANGE 

# 

THIS  IS  BASICALLY  A  MACHINE  ERROR 

* 

c 

5 

IF  (1.1)  ELEMENT  IS  IN  AN  ODD'  LOCATION 

* 

s 

6 

IF  ODD  STORAGE  TRAP  DURING  REDUCTION 

* 

THIS  MUST  BE  A  MACHINE  ERROR 

* 

a 

10 

+  I  IF  ERROR  CODE  3  OCCURED  SUBSEQUENT 

# 

TO  ERROR  CODE  I 

# 

s 

20 

+  I  IF  ERROR  CODE  4  OCCURED  SUBSEQUENT 

* 

TO  ERROR  CODE  I 

* 

ERR2 

s 

CURRENT  REDUCTION  STAGE  IF  ERR1-1 

# 

a 

RANK  OF  MATRIX  IF  ERR  1  =2 

* 

a 

0 

OTHERWISE 

# 

SCALE 

z 

0 

IF  ERR  1  NOT  =  3 

* 

B 

SCALING  FACTOR  IF  ERR1=3 

# 

DET* 

.  DECIMAL  PART  OF  DETERMINANT  IF  ERR1. 

* 

NOT  a  2  ~  A  NUMBER  GT  OR  E  TO  1.  AND  LT  10 

* 

B 

0 

IF  ERR  1=2 

* 

DETXP 

B 

EXPONENT  PART  OF  DETERMINANT  IF  ERR  1 

* 

NOT  =  2  -  AN  ADDRESS  INTEGER  GIVING 

* 

POWER  OF  TEN  FOR  DETERMINANT 

* 

DETERMINANT  ■  DET* 10 . **DETXP 

ENTRY 

INV4DS 

# 

* 

SET  UP 

CONSTANTS  AND  INITIALIZE  CELLS 

# 

INV4DS 

LMTM 

EFTM 

SXA 

XR 1  *  1 

SXA 

XR2t2 

SXA 

XR3.3 

SXA 

XR4.4 

SXA 

XR  5  ♦  5 

SXA 

X  R  6  #  6 

SXA 

XR7.7 

STZ 

0 

CLEAR  CELL  0  FOR  FPT 

STZ 

CHRCNG 

CLEAR  CELL  FOR  CHARACTERISTIC  SCALING 

STZ 

ERRCD1 

CLEAR  ERROR  CODE  CELLS 

STZ 

ERRCD2 

CAL 

8 

SAVE  CELL  8  FOR  (FPT) 

SLW 

TEMP8 

CAL 

FPTTRA 

STORE  TRANSFER  FOR  FPT  ANALYSIS. 

SLW 

8 

STZ* 

7.4 

ZERO  SCALING  CELL 

STZ 

DETXP 

ZERO  DETERMINANT  EXPONENT 

CLA* 

4.4 

STO 

PRINT 

SET  INDICATOR  FOR  PRINT 

I N VOOOOO 
INVOOOIO 
I NV00020 
INV00030 
INVOOOIO 
INVOOO&0 
INV00060 
I NVOOO  70 
invooobo 
I NV00090 
INV00100 
INV00110 
INV00120 
INV00130 
INV00140 
I NV001 30 
INV00160 
I NVOO 1 70 
I NV001 80 
INV00190 
INV00200 
I NV002 10 
I NV002  20 
I NV002  30 
INV00240 
I NV00250 
I NV00260 
INV00270 
INV00280 
INV00290 
I NV00300 
I NV003  10 
I N V003  20 
I NVOO  3  30 
I NV003 Ao 
INV00330 
INV00360 
INV00370 
I NV00380 
INV00390 
INV00400 
INV00410 
INV00420 
I NV00430 
I NV00440 
INV00430 
INV00460 
INV00470 
INVOO40O 
I NV00490 
INV00500 
INV00510 
INV00520 
INV00530 
INV00540 
INV00550 
INV00560 
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SSP 

XCA 

STO 

MPY 

XCA 

ALS 

STO 

ACL 

STA 

ACL 

STA 

ACL 

STA 

STA 

ADO 

STA 

ADO 

STA 

ADO 

STA 

CLA 

LBT 

TRA 

TRA 

STA 

STA 

ACL 

ACL 

STA 

SUB 

STA 

PAX 

SXD 

CLA 

LDQ 

DST* 

CLA 

DST* 

CLA 

TPL 

CALL 

NPRNT1  LXA 
SXD 
SXD 
PXA 
AXT 
PXA 
STO* 
STO* 
TXI 

STOINT  TXL 


AXT 

RDLPST  TSX 
SXA 


N 

N 


1 

TWONSQ 

3.4 

AP2NSQ 

N 

ADRINT 

N 

ADCINT 
MULTPL 
=  2 
DET 
=  1 

DETP1 
=  1 
TEN 
3.4 

*  +  2 
ERR  5 
ADA 

ADPVEL 

N 

N 

ADPVRW 

ADA 

TWON 

0.1 

REDUC4.1 
*  1  » 

-0 
DET 
=  10. 

TEN 
PRINT 
NPRNT1 
»  FWRD  * t  • 

N. 7 

RDLPED .  7 
STOINT. 7 

O. 0 
1.1 
0.1 

ADCINT 
ADRINT 
*+1.1.1 
*-4.1 .** 


2*N**2 


A+2*N**2 


ADDRESS  OF  ROW  INTEGERS  +  N 

ADDRESS  OF  COLUMN  INTEGERS  +N 
ADDRESS  OF  REDUCTION  FACTOR 

ADDRESS  OF  DETERMINANT 

ADDRESS  OF  DETERMINANT  LEAST  SIG. 


ADDRESS  OF  FLOATING  POINT  10 

TEST  TO  SEE  IF  STORAGE  IS  EVEN 
EVEN  STORAGE 
ODD  STORAGE  -  ERROR 
ADDRESS  OF  A 

ADDRESS  OF  CURRENT  PIVOT  ELEMENT 


ADDRESS  OF  CURRENT  PIVOT  ROW  +  2*N 
2*N 

STUFF  LOOP  CONTROL  FOR  REDUCE 


START  DET  OFF  AT  1. 

LOAD  10  IN  DOUBLE  PRECISION  CELL 


UN06. .TITLE) 

TEST  AT  END  OF  REDUCTION  LOOP 
PUT  INTEGERS  INTO  ROW  AND  COLUMN 

INTERCHANGE  ARRAYS 

ADCINT  HAS  A  TAG  OF  1 
ADRINT  HAS  A  TAG  OF  1 
INTEGERS  ARE  STORRED  BACKWARDS 
N  IN  DECREMENT 


START  OF  REDUCTION  LOOP 
REDUCTION  STAGE  IS  KEPT 
AT  THE  END  OF  THIS  LOOP 
ARITHMETIC  IS  DONE 


IN  XR1 

ALL  INVERSION 


1.1 

FINDLE.4 

TEMPXR.l 


INITIALIZE  REDUCTION 
FIND  LARGEST  ELEMENT 


STAGE 

IN  N-XR1+1  SUB  MATRIX 


INV00570 

INV005B0 

INV00590 

I NV00600 

INV00610 

INV00620 

I NV00630 

I NV00640 

INV006&0 

INV00660 

INV00670 

INVOO60O 

INV00690 

I NV00700 

INV00710 

I NV00720 

I NV007  30 

INV00740 

INV00750 

INV00760 

INV00770 

I NV007B0 

I NV00790 

INV00800 

I NV008  10 

I NV00820 

I NV008  30 

INV00840 

I  N  V008  )>0 

INV00860 

INV00870 

I NV00880 

INV00890 

INV00900 

INV00910 

I NV00920 

I NV009  30 

I NV00940 

INV009&0 

INV00960 

INV00970 

INV00980 

I NV00990 

I NV01000 

INV01010 

INVOIO^O 

INV01030 

INV01040 

I NVOIO^O 

INV01090 

I NVO 10T0 

INV01080 

INV01090 

INV01100 

INV01H0 

I NVO  1120 

I NVO  1 1 30 

I NV01140 

INVOU^O 

I NVO 1 1^0 
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PXA 

0.1 

SUB 

LGSTRW 

T2E 

COLTST 

CLA* 

DET 

CHS 

STO* 

DET 

TSX 

INRCHR  *4 

TSX 

TEMPXR 

TSX 

LGSTRW 

CLA 

ADRINT 

SUB 

LGSTRW 

STA 

*  +  2 

STA 

*  +  3 

CLA 

** 

LDQ* 

ADRINT 

STQ 

** 

STO* 

ADRINT 

COLTST 

PXA 

0.1 

SUB 

LGSTCL 

TZE 

PRNTPV 

CLA* 

DET 

CHS 

STO* 

DET 

TSX 

INRCHC .4 

TSX 

TEMPXR 

TSX 

LGSTCL 

CLA 

ADCINT 

SUB 

LGSTCL 

STA 

*  +  2 

STA 

*  +  3 

CLA 

** 

LDQ* 

ADCINT 

STO 

** 

STO* 

ADCINT 

PRNTPV 

CLA 

PRINT 

T  PL 

STRTSC 

LFTM 

PXA 

0.1 

TSX 

.FCNV. .4 

CLS 

CHRCNG 

ADM* 

ADPVEL 

LDQ 

ADPVEL 

LLS 

0 

TSX 

.FCNV. .4 

CLA* 

ADRINT 

TSX 

.FCNV. .4 

CLA* 

ADCINT 

TSX 

.FCNV  .  .4 

EFTM 

* 

# 

STRTSC 

TXH 

SCLOOP  + 1 .1.1 

CAL* 

ADPVEL 

LARGEST 

ELEMENT  *  PIVOT  ELEMENT 

ANA 

*0377000000000 

MASK 

OUT  ALL  BUT  CHARACT ER I  ST 

SUB 

=0177000000000 

FIND 

DIFFERENCE  FROM  177 

CHS 

STO 

CHRCNG 

SAVE  CHARACTERISTIC  SCALING 

TZE 

SCLOOP+l 

BY-PASS 

SCALING  IF  NOT  NEEDED 

LXA 

TWONSQ . 7 

FSTSCL 

NZT  * 

AP2NSQ 

AP2NSQ 

HAS  A  TAG  OF  7 

INV01170 
INV01180 
INV011V0 
INV01200 
INV01210 
INV01220 
INV01230 
INV01240 
INV01230 
INV01260 
INV01270 
INV01280 
INV012V0 
INVO13O0 
INV01310 
I  NVO  1 3KO 
INV01330 
I NVO 1 340 
INV01330 
INV01360 
INV01370 
INV01380 
INV01390 
INV01400 
INV01410 
INV014Z0 
INV01430 
I NV01440 
INV01430 
I NV01460 
INV01470 
I NV01480 
INV014VO 
INV01500 
INV01510 
INV01520 
INV01530 
INV01540 
INV01530 
INV01560 
I NV01570 
INV01580 
INV01590 
INV01600 
INV01610 
INV01620 
I  NVO 16 30 
I NVO 1 640 
I NVO 1630 
INV01660 
INV01670 
I NVO 1680 
I NVO  1690 
I NV01700 
I NVO 1 7 10 
I NV01720 
I NVO 1 7  30 
I NVO 1740 
I NVO  1730 
I NV01760 
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*  oc 


SCLOOP 


ADJUST 


RDLPED 


# 

* 

* 

» 

EDOVR 


RWSRCH 


FOUNDR 


TRA 

SCLOOP 

NUMBER  IS  ZERO.  DO  NOT  SCALE 

INV01770 

CLA 

CHRCNG 

SCALE  NUMBER 

INV017U0 

ADM* 

AP2NSQ 

INV01790 

TPL 

*  +  3 

INV01800 

STZ* 

AP2NSQ 

IF  NEGATIVE.  UNDERFLOW  OCCURRED 

I NVO 1 8 1 0 

TRA 

SCLOOP 

INVOIB^O 

LDQ* 

AP2NSQ 

SCALING  SUCCESSFUL.  RESTORE  SIGN 

I NVO  1830 

LLS 

0 

I NVO 18  +0 

STO* 

AP2NSQ 

STORE  IN  ORIGINAL  LOCATION 

INV018&0 

T  I X 

FSTSCL.7.1 

END  OF  SCALING  LOOP 

I NV01860 

TSX 

REDUCE. 4 

PERFORM  CURRENT  REDUCTION  STAGE 

I NVO 1 8  70 

DLD* 

ADPVEL 

INV018B0 

TSX 

SCALE  .4 

SCALE  PIVOT  ELEMENT 

I NVO 1 890 

DFMP* 

DET 

I NV01900 

TSX 

SCALE. 4 

SCALE  PRODUCT 

I NVO 19 10 

DST* 

DET 

RUNNING  PRODUCT  OF  PIVOT  ELEMENTS 

INV019Z0 

LXA 

TWON.7 

I NVO 1 9 JO 

Old* 

ADPVEL 

I NVO 1 940 

DST* 

MULTPL 

KEEP  PIVOT  ELEMENT  TEMP.  IN  MULTPL 

INV019&0 

DLD* 

ADPVRW 

ADPVRW  HAS  TAG  OF  7 

INV01960 

DFDP* 

MULTPL 

INV01970 

DST* 

ADPVRW 

DIVIDE  PIVOT  ROW  BY  PIVOT  ELEMENT 

I NVO 1 960 

T  IX 

ADJUST .7.2 

INV01990 

CLA 

*  1  • 

INV02000 

LDQ 

=  0 

I NV020 IQ 

DFDP* 

MULTPL 

INV02020 

DST* 

ADPVEL 

PUT  l/IPIV.  ELEM)  INTO  PIVOT  POSITION 

INV02030 

TXI 

*+1.1*1 

INCREMENT  TO  NEW  REDUCTION  STAGE 

INV02040 

TXH 

REDOVR » 1  »** 

N  IN  DECREMENT-LOOP  EXIT 

INV020&0 

CLA 

ADPVEL 

I NV020&0 

ADD 

=  2 

INV02070 

ADD 

TWON 

INV02060 

STA 

ADPVEL 

INCREMENT  BY  2*N+2 

INV02090 

CLA 

ADPVRW 

INV02100 

ADD 

TWON 

INV02U0 

STA 

ADPVRW 

INCREMENT  BY  2*N 

INV021Z0 

TRA 

RDLPST 

ANOTHER  REDUCTION  STAGE 

INV02130 

INV02140 

ALL  ARITHMETIC  IS  OVER  NOW  REARANGE  ROWS 

AND  COLUMNS 

INV02160 

INV02160 

INV02170 

FIRST.  INTERCHANGE  COLUMNS  ACCORDING  TO  ROW  TABLE 

INV02160 

INV02190 

LXA 

N .  7 

I NV02200 

STZ 

TEMPI 

CLEAR  FOR  XR  USE 

I NV022 10 

PXA 

0.7 

INV02220 

PAX 

0.1 

INV02230 

PXA 

0,7 

INV02240 

SUB* 

ADRINT 

ADRINT  HAS  A  TAG  OF  1 

INV02230 

TZE 

FOUNDR 

INV022b0 

T  I X 

RWSRCH. 1,1 

INV02270 

TRA 

ERR4 

INV02280 

PXA 

0.7 

I NV02290 

SXA 

TEMPI, 1 

INV02300 

SUB 

TEMPI 

INV02310 

TZE 

RWLPED 

COLUMN  IS  IN  CORRECT  PLACE 

INV02320 

SXA 

TEMPXR  ,  7 

INV02330 

TSX 

INRCHC.4 

INV02340 

TSX 

TEMPXR 

ROW  INTEGER  FOUND 

INV02330 

TSX 

TEMPI 

LOCATION  OF  ROW  INTEGER 

INV02360 
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LXA 

CLA 

SUB 

STA 

CLA 

STO* 

CLA 

STO* 

RWLPED  T I X 


LXA 

PXA 

PAX 

CLSRCH  PXA 
SUB* 
TZE 
T  I X 
TRA 

FOUNDC  PXA 
SXA 
SUB 
TZE 
SXA 
TSX 
TSX 
TSX 

# 

LXA 

CLA 

SUB 

STA 

CLA 

STO* 

CLA 

STO* 

CLLPED  T I  X 
* 

* 

# 

* 

CLA 

TZE 

TMI 

AXT 

CLA 

ADD 

STA 

TSX 

CLA 

ADM 

PBT 

TRA 

TRA 

RESCAL  LXA 
CLA 
ADM* 
ZET* 


INTERCHANGE  ROW  INTEGERS. 

TEMPXR  #7 
ADRINT 
TEMPXR 
*  +  l 
** 

ADRINT  ADRINT  HAS  A  TAG  OF  1 

TEMPXR 

*- 3 

RWSRCH-2  » 7  *  1  LOOP  FOR  N  ROWS. 

NOW  INTERCHANCE  ROWS  ACCORDING  TO  COLUMN  TABLE 


N  *7 
0.7 
0.1 
0.7 

ADCINT  ADCINT  HAS  A  TAG  OF  1 

FOUNDC 

CLSRCH. 1.1 

ERR4 

0.7 

TEMPI  .1 
TEMPI 

CLLPED  ROW  IS  IN  CORRECT  PLACE 

TEMPXR. 7 

INRCHR  .4 

TEMPXR 

TEMPI 

INTERCHANGE  COLUMN  INTEGERS 
TEMPXR . 7 
ADCINT 
TEMPXR 
*  +  l 
#■  * 

ADCINT  ADCINT  HAS  A  TAG  OF  1 

TEMPXR 

*-3 

CLSRCH-2.7.1  LOOP  FOR  N  COLUMNS 

INVERSE  IS  NOW  IN  THE  CORRECT  FORM  -  TIME  TO 
RESCALE  THE  SCALED  INVERSE 


IF  CHRCNG=  0 .  RESCALING  UNNECESSARY 
IF  NEGATIVE.  NO  OVERFLOW  PROBLEMS 
SET  UP  XR1  FOR  FINDLE 
SET  UP  TO  PIVOT  ROW  1  FOR  FINDLE 


FIND  LARGEST  ELEMENT  IN  SCALED  INVERSE 

FINDLE  STORES  LARGEST  IN  TEMPI 
WAS  THERE  OVERFLOW 
NO 
YES 


AP2NSQ  HAS  A  TAG  OF  7 


CHRCNG 
DSLPED+1 
RESCAL 
1.1 
ADA 
TWON 
ADPVRW 
FINDLE. 4 
CHRCNG 
TEMPI 

*  +  2 

ERR3 

TWONSQ  .7 
CHRCNG 
AP2NSO 
AP2NSQ 


INV02370 

INV023B0 

INV023V0 

INV02400 

INV02410 

INV02420 

1NV024J0 

I N VO  2  440 

INV024b0 

I NV02460 

INV02470 

INV024B0 

INV02490 

INVO25O0 

INV02S10 

I NV02520 

INV025A0 

INV02S40 

INV025R0 

I NV02560 

INV02570 

I NV02SB0 

INV025Y0 

INV02600 

I NV026 10 

I NV02620 

INV02630 

I NV02640 

I NV026B0 

INV02660 

INV02670 

I NV026B0 

I NV02690 

I NV02700 

INV02710 

INV02720 

I NV027  30 

I NV02740 

I NV02770 

INV02760 

I NV02770 

I NV027B0 

I NV027V0 

INV02800 

I NV028 10 

I NV02820 

INV02830 

INV02840 

I NV028B0 

I NV02860 

INV02870 

INV028B0 

I NV028 VO 

INV02900 

INV02910 

I NV02920 

I NV02930 

INV02940 

I NV029B0 

INV02960 


*  73 


TPL 

STZ* 

TRA 

LDQ* 

LLS 

STO* 

SCLED  T I X 


#+3  NO  UNDERFLOW  IF  POSITIVE 

AP2NSQ  UNDERFLOW*  STORE  ZERO 

RSCLED 
AP2NSQ 
0 

AP2NSQ 

RESCAL+1 *7*1  LOOP  FOR  2*N**2  NUMBERS 


NOW  RESCALE  THE  DETERMINANT 


NZT  * 

TRA 

CLA 

CHS 

STO 

LXA 

STDSCL  CLA 
ADM* 
PBT 
TRA 
TRA 
TMI 
LDQ* 
LLS 
STO* 
CLA 
ADM* 
TPL 
PXA 
LLS 
STO* 
DLD* 
TSX 
DST  * 
TRA 

DIVDET  DLD* 
DFDP* 
DST* 
TRA 

MLTDET  DLD* 
DFMP* 
DST* 
TRA 

DSLPED  T  I  X 


DET 

DSLPED+1 

CHRCNG 

CHRCNG 
N  *  7 

CHRCNG 

DET 

*  +  2 

DIVDET 

MLTDET 

DET 

0 

DET 

CHRCNG 
DETP1 
*  +  2 
0*0 
0 

DETP1 

DET 

SCALE  •  4 
DET 

DSLPED 

DET 

TEN 

DET 

STDSCL 

DET 

TEN 

DET 

STDSCL 
STDSCL. 7*1 


IS  MATRIX  SINGULAR 
IF  SINGULAR*  RETURN 


NO  OVERFLOW 

OVERFLOW*  DIVIDE  BY  10 
UNDERFLOW*  MULTIPLY  BY  10 


SCALE  LEAST  HALF 

POSITIVE  IF  NO  UNDERFLOW 
ZERO  LEAST  HALF  IF  UNDERFLOW 
RESTORE  SIGN  TO  LEAST  HALF 


GO  TO  END  OF  LOOP 
DIVIDE  DET  BY  TEN 


MULTIPLY  DET  BY  TEN 


LOOP  N  TIMES  FOR  COMPLETE  SCALING 


CLA 

PRINT 

TPL 

XRl 

CALL 

•  FF  I  L 

XRl 

AXT 

***1 

XR2 

AXT 

**  *  2 

XR  3 

AXT 

**  *  3 

XR4 

AXT 

**  *  4 

XR5 

AXT 

**  .  5 

XR6 

AXT 

**  *  6 

XR7 

AXT 

**  *7 

CAL 

TEMP8 

SLW 

8 

DLD* 

DET 

END  OF  ALL  ARITHMETIC  NOW  TIME  TO  ARRANGE 
ERROR  CODES  AND  SUCH  THEN  RETURN 
DID  WE  P-INT 


RESTORE  CELL  8 


INV02970 
INV029B0 
I NV02990 
I NV030UO 
I NV030 10 
I NV030^0 
1NV03030 
INV030A0 
I NV030B0 
INV030O0 
INV03070 
I NV030B0 
I NV03090 
INV03100 
INVO3U0 
INV031Z0 
INV03130 

INV031A0 

INV031&0 
INV03160 
INV03 1 70 
INV031O0 
1NV03190 
I NV032Q0 
INV03210 
I NV03  2  ^0 
INV032 30 
I NV032 AO 
I NV032S0 
INV03260 
INV03270 
I NV03280 
I NV03290 
INV03300 
I NV033 10 
I NV03340 
I  NV033-30 
INV033A0 
I NV033B0 
INV03360 
INV03370 
INV03380 
INV03390 
I N VO  3400 
INV03410 
I NV034^0 
I N VO  3  4  30 
I  NV034*+0 
INV034B0 
I  NV034t>0 
INV03470 
I NV03480 
I NV03490 
I NV03500 
INV03510 
I NV03520 
INV03530 
I  NV035*+0 
INV03530 
I NV03560 
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DST* 

8.4 

I NV03570 

CLA 

DETXP 

I NV03580 

STO* 

9.4 

I NV03590 

CLA 

ERRCD1 

INV03600 

STO* 

5.4 

I  N VO  36 10 

CLA 

ERRCD2 

INV03620 

STO* 

6.4 

I NV03630 

TRA 

10.4 

INV03640 

* 

I NV03630 

* 

FOLLOWING 

ARE  ALL  THE  ERROR  STOPS 

I NV03660 

» 

INV03670 

ERR  1  CLA 

=  1 

OVERFLOW  RETURN 

I NV03660 

STO 

ERRCD1 

I NV03690 

SXA 

ERRCD2 .1 

SAVE  REDUCTION  STAGE 

I NV03700 

STZ* 

DET 

ZERO  DETERMINANT 

I NV037  10 

STZ* 

DETP1 

I NV03720 

STZ 

DETXP 

I NV03730 

TRA 

REDOVR 

TRANSFER  BACK  TO  INTERCHANGE  ROWS 

INV03740 

» 

AND  COLUMNS.  AND  RESCALE 

I NV03750 

ERR2  CLA 

=  2 

I  N  V  0  3  7  6  0 

STO 

ERRCD1 

I NV03770 

PXA 

0.1 

INV037UC 

SUB 

=  1 

INV03790 

STO 

ERRCD2 

RANK  OF  MATRIX  =XR1~1 

I NV03800 

TRA 

ERR  1  +  3 

TRANSFER  BACK  TO  INTERCHANGE 

I  NV038 10 

» 

ROWS  AND  COLUMNS.  AND  RESCALE 

INV03820 

ERR3  CLA 

ERRCD1 

I  NV03830 

TNZ 

ERR3PL 

I N VO 3 8 40 

CLA 

=  3 

INV03850 

STO 

ERRCD1 

I NV03860 

CLA 

=  1  . 

=0201400000000 

I NV03870 

ADD 

CHRCNG 

INV03880 

LXA 

XR4.4 

INV03890 

STO* 

7.4 

STORE  SCALING  FACTOR 

I  N  V  0  3  9  0  0 

TRA 

RSCLED+1 

GO  BACK  AND  SCALE  DETERMINANT 

INV03910 

ERR4  CLA 

ERRCD1 

CANNOT  RE-ARRANGE  ROWS. COLUMNS  -MACH. 

ERRORI NV039Z0 

TNZ 

ERR4PL 

I  NV03930 

CLA 

=  4 

INV03940 

STO 

ERRCD1 

CANNOT  RE-ORDER  ROWS  AND  COLUMNS 

INV03930 

TRA 

DSLPED+ 1 

RETURN  IMMEDIATELY 

I NV03960 

ERR5  CLA 

=  5 

Atl.l)  NOT  IN  EVEN  CELL 

INV03970 

STO 

ERRCD1 

I NV03980 

TRA 

DSLPED+1 

RETURN  IMMEDIATELY 

INV03990 

ERR6  CLA 

=  6 

INV04000 

TRA 

ERR5+1 

I NV040 10 

ERR3PL  ADD 

=  10 

I NV040Z0 

TRA 

ERR3+3 

I NV04030 

ERR4PL  ADD 

=  20 

I  N  V  0  4  0  4  0 

TRA 

ERR4+3 

I NV04030 

* 

I NV04060 

* 

STORAGE  FOR  PROGRAM  CONSTANTS 

INV04070 

* 

I NV040O0 

TEMPS  PZE 

0 

STORAGE  FOR  CORE  LOCATION  8  (DEC) 

I  N  V  0  4  0  9  0 

FPTTRA  TRA 

FLPSPL 

INV04100 

CELLO  PZE 

0 

STORAGE  FOR  FLPSPL  CODE 

INV041 10 

DET  PZE 

0 

ADDRESS  OF  DETERMINANT 

INV041Z0 

DETP 1  PZE 

0 

ADDRESS  OF  LEAST  SIG.  PART  OF  DET. 

I NV04130 

MULTPL  PZE 

0 

ADDRESS  OF  REDUCTION  FACTOR 

I NV04140 

TEN  PZE 

0 

ADDRESS  OF  FLOATING  POINT  10. 

INV04160 

DETXP  PZE 

0 

CELL  FOR  DETERMINANT  EXPONENT 

I NV0416Q 

N  PZE 

0 

I NV04 1 7  0 

TWON  PZE 

0 

2*N 

INV04160 

TWONSQ  PZE 

0 

2*N**2 

I NV04 1 VO 

ADA  PZE 

0 

ADDRESS  OF  MATRIX 

INV04200 

ADPVEL  PZE 

0 

ADDRESS  OF  CURRENT  PIVOT  ELEMENT 

I NV042 10 

ADPVRW  PZE 

0  i  7 

ADDRESS  OF  CURRENT  PIVOT  ROW 

+  2N 

INV04220 

ADOPEL  PZE 

0,6 

ADDRESS  OF  ELEMENT  BEING  REDUCED 

INV04230 

ADOPRW  PZE 

0,7 

ROW  OF  ADOPEL 

INV04240 

AP2NSQ  PZE 

0,7 

ADDRESS  OF  1ST  CELL  BEYOND  MATRIX 

INV04250 

ADRINT  PZE 

0,1 

ADDRESS  OF  ROW  INTEGERS  +  N 

INV04260 

ADCINT  PZE 

0,1 

ADDRESS  OF  COLUMN  INTEGERS  + 

N 

I NV042  70 

LGSTRW  PZE 

0 

ROW  INDEX  OF  LARGEST  ELEMENT 

IN  SUB¬ 

MATRIX  INV042B0 

LGSTCL  PZE 

0 

COLUMN  INDEX  OF  LARGEST  ELEM. 

IN  SUB 

-MATRIXINV042Y0 

CHRCNG  PZE 

0 

CHARACTERISTIC  SCALE  FACTOR 

I NV04300 

ERRCD1  PZE 

0 

ERROR  CODE  1 

INV04310 

ERRCD2  PZE 

0 

ERROR  CODE  2 

INV04320 

TEMPI  PZE 

0 

INV04330 

TEMP 2  PZE 

0 

INV04340 

TEMPXR  PZE 

0 

TEMPORARY  FOR  ADDRESS  ONLY 

I NV04330 

TEMPAC  PZE 

0 

TEMPORARY  STORAGE  FOR  FLPSPL 

I NV04360 

TITLE  3CI 

6 , ( 1H1 , 10X»93HBELOW  ARE  THE  PIVOT  TERM 

INV04370 

BCI 

7 , S  DERIVED  DURING  INVERSION  AND  THEIR  ORIGI 

INV043O0 

BCI 

6  »NAL  ROW  -  COLUMN  LOCAT IONS. / 1H0 » 22X * 

INV04390 

BCI 

6»9HREDUCTION*8X,5HPIVOT.9X»3HROW.5X, 

I NV04400 

BCI 

6,6HC0LUMN/24X*5HSTAGE, 1 1 X *4HTERM , 9X , 

I NV04410 

BCI 

6,6HNUMBER,3X*6HNUMBER/( 1H0*24X* I3*6X» 

INV04420 

BCI 

4,1PE14.6*6X, 

13, 6X  ,13)) 

I NV04430 

PRINT  PZE 

0 

INV04440 

* 

CLOSED  SUBROUTINE  TO  INTERCHANGE  ROWS 

I NV044&0 

* 

TWO  ARGUMENTS 

-I»J»ROWS  TO  BE  MOVED 

I NV04460 

« 

INV04470 

* 

INV04480 

INRCHR  LDQ* 

1,4 

INV04490 

MPY 

TWON 

INV04500 

XCA 

I NV045 10 

ADD 

ADA 

ADDRESS  OF  ROW  I  +  2N 

I NV045^0 

STA 

I  NR  1 

INV04530 

STA 

I  NR  1  +  3 

INV04540 

LDQ* 

2,4 

INV045^0 

MPY 

TWON 

INV04560 

XCA 

INV04570 

ADD 

ADA 

ADDRESS  OF  ROW  I  +  2  N 

INV04560 

STA 

INR1+1 

INV04590 

STA 

I  NR  1  +  2 

I NV04600 

LXA 

TWON, 7 

INV04610 

I  NR  1  CLA 

**  ,  7 

ROW  I 

I NV046^0 

LDQ 

**  ,  7 

ROW  J 

I NV04630 

STO 

** ,  7 

ROW  J 

I NV04640 

STQ 

** ,  7 

ROW  I 

INV046t>0 

T  I X 

INR1 ,7,1 

INV04660 

TRA 

3,4 

DONE 

I NV046  70 

# 

INV04660 

* 

CLOSED  SUBROUTINE  TO  INTERCHANGE  COLUMNS 

I  NV04690 

* 

TWO  ARGUMENTS 

-I»J  -  COLUMNS  TO  BE  MOVED 

INV04700 

• 

INV04710 

I  NRCHC  CLA 

ADA 

INV047Z0 

SUB 

=  1 

INV04730 

ADD 

TWONSQ 

INV04740 

STO 

TEMP2 

A-1+2*N**2 

I NV047&0 

CLA* 

1*4 

INV04760 

ALS 

1 

ADD 

TEMP2 

ADDRESS  OF  COLUMN  I+2N**2+1 

STA 

INC1 

STA 

INC1+3 

CLA* 

2*4 

ALS 

ADD 

1 

TEMP  2 

ADDRESS  OF  COLUMN  J  +  2N**2+1 

STA 

INC1+1 

STA 

INC1+2 

LXA 

TWONSQ  *  7 

LXA 

TwON » 6 

SXD 

I NC2  *  6 

LXA 

=  2.6 

INC  1  CLA 

**  •  7 

COLUMN  I 

LDQ 

**  •  7 

COLUMN  J 

STO 

**  *  7 

COLUMN  J 

STQ 

**  .7 

COLUMN  I 

TXI 

*+l .7*1 

SMALL  LOOP  TO  EXCHANGE  LEAS.  SIG 

T  IX 

INC1.6.1 

TXI 

*  +  l *7  *-2 

INC2  T I X 

INC1-1  .7.0 

MAIN  LOOP  -2N  IN  DECREMENT 

TRA 

3.4 

DONE 

CLOSED  SUBROUTINE  TO  FIND  THE  LARGEST 

MAGNITUDE  IN 

THE  N-XR1+1  SQUARE  SUB-MATRIX 

CURRENT  REDUCTION  STAGE  IS  IN  XR1 

ROW  LOCATION 

OF  L.E.  =  LGSTRW 

COLUMN  LOCATION  OF  L.E.  =  LGSTCL 

NDLE  PXA 

0.1 

SUB 

N 

SUB 

=  1 

PAX 

0.3 

COUNT  OF  ROWS  IN  XR3=N+1-XR1 

ALS 

1 

STA 

TEMPXR 

TEMPXR=2(N+1-XR1)-T0  GO  INTO  XR7 

SXA 

LGSTRW.l 

START  LOCATION  AT  PIVOT  ELEMENT 

SXA 

LGSTCL. 1 

CLA 

ADPVRW 

STA 

FLE1+1 

STZ 

TEMPI 

KEEP  LARGEST  IN  TEMPI 

LXA 

TEMPXR .7 

FLE1  PXA 

0  .0 

ADM 

** » 7 

CAS 

TEMPI 

TRA 

*  +  3 

GREATER  -  EXCHANGE 

TRA 

*  +  5 

TRA 

*  +  4 

STO 

TEMPI 

SXA 

LGSTRW.3 

SXA 

LGSTCL. 7 

T  I X 

FLE1.7.2 

LOOP  BACK  IF  ROW  NOT  DONE 

CAL 

FLE 1+1 

ADD 

TWON 

STA 

FLE1+1 

INCREMENT  TO  NEW  ROW 

T  I X 

FLEl-1.3,1 

LOOP  BACK  IF  MORE  ROWS 

NZT 

TEMPI 

DONE.  IS  LARGEST  ELEMENT  =  0 

TRA 

ERR2 

SINGULAR  MATRIX  ERROR  RETURN 

ADJUST  LGSTRW.  CL 

CLS 

LGSTRW 

ADD 

N 

INV04770 
INV047B0 
INV04790 
I NV04800 
INV04810 
I NV04820 
INV04830 
INV04840 
I NVQ48S0 
INV04860 
I NV048  7 0 
I NV04800 
INV04890 
INV04900 
I NV049 10 
I N V049  20 
INV049 JO 
INV04940 
INV04930 
INV04960 
INV04970 
INV049B0 
INV04990 
INV05000 
INV05010 
I NV05020 
I NV0S030 
I NV05040 
INV0S030 
INV030t>0 
1NV050?0 
INVOSOBO 
INV05090 
INV05100 
I NV05 1 10 
1 NV05120 
INV08130 
I NV05140 
I NV03 1 30 
INV05160 
INV05170 
INVO510O 
INV05190 
I NVOS200 
INV05210 
INV05220 
I  NV03230 
INV05240 
INV05230 
INV05260 
INV05270 
INV05260 
INV05290 
INV05300 
INV05310 
I NV05320 
I N VO  5  3  30 
INV05340 
INV05330 
INV03360 
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* 

# 

# 

* 

* 

* 

* 


ADD 

=  1 

STA 

lgstrw 

CLS 

LGSTCL 

ARS 

1 

ADD 

N 

ADD 

=  1 

STA 

LGSTCL 

TRA 

1.4 

CLOSED 
STAGE  ' 

ZLKQS  U  IN  IHt  '  1  Vw  I  V-Wtunn  «  *  *  ”  ' 

PIVOT  POSITION-  ZEROS  AND  1  ARE  ONLY  UNDERSTOOD 
DUE  TO  STORAGE  OVER  ITSELF 
XR1=REDUCT ION  STAGE 


REDUCE  LXA 
SXA 
CLA 
ADD 
STA 
SUB 
ADD 
ADD 
SUB 
ADD 
STA 
AXT 

REDUC1  PXA 
SUB 
TZE 
DLD* 
TZE 
DFDP* 
CHS 
DST  * 
LXA 

REDUC2  DLD* 
DFMP* 
DFAD* 
DST* 

T  IX 

DLD* 

DST* 

REDUC3  CLA 
ADD 
STA 
TXI 

REDUC4  T IX 
TRA 

# 

* 

* 

* 

* 

* 

» 

SCALE  STO 
SSP 
LRS 


TWONSQ  *  6 

TEMPXR ♦ 1 

ADA 

TWON 

ADOPRW 

TWON 

TEMPXR 

TEMPXR 

=  2 

TWONSQ 

ADOPEL 

1.5 

0.5 

TEMPXR 

REDUC3 

ADOPEL 

REDUC3 

ADPVEL 

MULTPL 

TWON. 7 

ADPVRW 

MULTPL 

ADOPRW 

ADOPRW 

REDUC2 .7.2 

MULTPL 

ADOPEL 

ADOPRW 

TWON 

ADOPRW 

*+1.5.1 

REDUC1 .6T** 

1.4 


2N  +  ADDRESS  OF  ROW  BEING  REDUCED 


2N**2  +  ADDRESS  OF  ELEMENT  BEING  ZEROED 
COUNT  OF  ROWS  BEING  REDUCED 


DO  NOT  OPERATE  ON  PIVOT  ROW 
ADOPEL  HAS  A  TAG  OF  6 

IF  ALREADY  ZERO*  NO  REDUCTION  NECESSARY 

USE  NEGATIVE  RATIO 
REDUCTION  FACTOR 

ADPVRW  HAS  A  TAG  OF  7 

ADOPRW  HAS  A  TAG  OF  7 


PUT  REDUCTION  FACTOR  WHERE 
ZERO  WAS  PRODUCED 


GO  TO  NEXT  ROW 

XR5  =  ROW  ABOUT  TO  BE  REDUCED 

2N  IN  DECREMENT 

DONE 


CLOSED  SUBROUTINE  TO  SCALE  AN  INCOMING 
MUMBER  SO  THAT  IT  IS  LESS  THAN  10.  AND 
3REATER  THAN  OR  EQUAL  TO  1.  DIVISIONS  AND 
MULTIPLICATIONS  KEPT  TRACK  OF  IN  DETXP . 

NUMBER  EXPECTED  IN  AC  AND  MQ-RESULT  LEFT  THERE 


TEMPAC 


0 


INV05370 

INV05360 

I NV05390 

INV05400 

INV05410 

INV05420 

I NV05430 

INV05440 

INV05450 

I NV05460 

I NV0547  0 

INV054B0 

I NV05490 

INV05500 

INV05510 

I NV05520 

I NV05  5  30 

INV05540 

INV05550 

INV05560 

INV05570 

I NV055S0 

INV05590 

I NV05600 

INV05610 

INV05&20 

I  NV05630 

INV05640 

INV05650 

INV05660 

I NV05670 

INV/056B0 

INV05690 

INV05700 

I NV057 10 

INV05720 

I NV05730 

INV05740 

INV05750 

INV05760 

INV05770 

INV057B0 

I NV0579C 

I NV05800 

I NV05S 10 

INV05820 

INV05830 

I NV0584Q 

I NV058  50 
INV05860 
I NV058  70 
INV058B0 
INV05890 
INV05900 
INV05910 
INV05920 
INV05930 
INV05940 
INV05950 
INV05960 
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SCALE1 

CAS* 

TEN 

INV05970 

TRA 

DIVIDE 

INV059&0 

TRA 

DIVIDE 

INV05990 

TSTONE 

CAS 

=  1. 

INV06000 

TRA 

CHKSGN 

I NV060 1 0 

TRA 

CHKSGN 

INV060Z0 

DFMP* 

TEN 

INV06030 

OST* 

MULTPL 

TEMPORARY 

STORAGE 

INV06040 

CLA 

DETXP 

INV060S0 

SUB 

=  1 

INV060&0 

STO 

DETXP 

I NV060  70 

DLD* 

MULTPL 

INV060O0 

TRA 

TSTONE 

INV060V0 

DIVIDE 

DFDP* 

TEN 

I NV06 1 00 

DST  * 

MULTPL 

I N V06 1  A  0 

CLA 

DETXP 

INV06U0 

ADD 

=  1 

INV06130 

STO 

DETXP 

I NV06 1 40 

DLD* 

MULTPL 

INV061P0 

TRA 

SCALE1 

I NV06160 

CHKSGN 

DST* 

MULTPL 

I NV06170 

CLA 

TEMPAC 

INV061B0 

LRS 

0 

I  N  V  0  6 1 9  0 

CLA* 

MULTPL 

INV06200 

LLS 

0 

INV06210 

TRA 

1  *4 

INV06220 

# 

I NV06230 

* 

FLOATING  POINT  SPILL  ROUTINE  TO 

ANALYZE 

INV06240 

# 

OVER/UNDER 

FLOW  DURING 

DOUBLE 

PRECISION 

INV06230 

# 

OPERATIONS 

INV06260 

* 

INV06270 

FLPSPL 

STO 

TEMPAC 

INV062B0 

CLA 

0 

INV06290 

STD 

CELLO 

INV06300 

CLA 

CELLO 

I NV063 lQ 

CAS 

=  3B 1-7 

INV06320 

TRA 

TSTSTO 

CHECK  TO 

BE  SURE 

IT  IS  NOT  A  STORAGE  TRAP 

I NV06330 

TRA 

*  +  4 

UNDERFLOW 

IN  AC 

AND  MQ 

I NV06340 

CLA 

TEMPAC 

UNDERFLOW 

IN  MQ 

ONLY 

INV06330 

LDQ 

=  0 

I  NV06360 

TRA* 

0 

RETURN 

INV06370 

PXA 

0*0 

INV063B0 

TRA 

*-3 

INV06390 

TSTSTO 

CAS 

=  7B17 

I NV06400 

TRA 

ERR6 

ODD  STORAGE  TRAP 

INV06410 

TRA 

ERR  1 

OVERFLOW 

IN  AC  OR 

AC  AND  MQ 

INV06420 

TRA 

ERR1 

I NV06430 

* 

I NV06440 

END 

I NV99990 

SUBROUTINE  DATASB 


SldMAP 

DATASB 

4 • DECK #M94/2 

DAT00000 

ENTRY 

DATA 

DATOOOlO 

DATA 

P2E 

12000 

DAT00020 

P2E 

8000 

DAT  00030 

BSS 

11999 

DAT00040 

END 

DAT99990 
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SUBROUTINE  KRD 


SIBMAP  FKRD  100»DECK,XR7,M94 
»KRD  7090  FORTRAN  LIBRARY  /  BCD 
***************** 


TAPE  INPUT  ROUTINE 

******************* 


M  «  KRD  ( A » NZ  » IRROR.NFC.NCOLtNWT  * LOGIC) 


■» 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 


•* 


A 

NZ 

IRROR 


NFC 

NCOL 

NWT 

LOGIC 

M 


-  BEGINNING  STORAGt  LOCATION. 

-  IF  ZERO*  WILL  EXIT  AFTER  EACH  CARD. 

IF  ONE*  WILL  tXlT  AFTtR  E ND-F I L E-CODE ( 1 2 

-  LOCATION  WHERE  ERROR  CODES  ARE  STORED. 


PCH-COL  72) 


0  SUCCESSFUL. 

1  PH Y I SCAL  END-OF-FILE  ON  TAPE. 

2  NFC*NCOL  GREATER  THAN  72. 

3  IMPROPER  NUMBER  FOLLOWING  B. 

4  ILLEGAL  CHARACTER  IN  DATA  FIELD. 

5  DIVIDE  CHECK  IN  CONVERTING  TO  FX  PT. 

6  OVERFLOW  CONVERTING  TO  FLOATING  BINARY. 

7  EFFECTIVE  POWER  GREATER  THAN  38. 

8  FIELD  VALUE  GREATER  THAN  34*359*738.367. 

9  ILLEGAL  CHARACTER  IN  COLUMN  72. 

10  MACHINE  FAILURE. 

11  END  OF  BUFFER  ERROR  READING 

-  NUMBER  OF  FIELDS  TO  CONVERT. 

-  NUMBER  OF  COLUMNS  PER  FIELD. 

-  NUMBER  OF  WORDS  FOLLOWING  THE  CONVERSION  FIELDS  TO 

TRANSFER  AS  UNCONVERTED  BCD  WORDS. 

-  LOGICAL  TAPE  NUMBER 

-  NUMBER  OF  CARDS  SUCCESSFULLY  CONVERTED. 


* 

*  CONVERSION  OF  BCD  CARD  IMAGES  IN  CORE 

*  CALL  KRDG  ( A , 6  *  I RROR . NF C . NCOL ) 


B  -  LOCATION  OF  1ST  WORD  OF  BCD  FIELDS 
TO  BE  CONVERTED. 

2ND  WORD  AT  8+1*  ETC. 


REM 

ENTRY 

KRD 

ENTRY 

KRDG 

KRD 

LDIR 

STZ 

CLAUDE 

TRA 

CART 

KRDG 

STL 

CLAUDE 

CART 

SAVE 

4,1, 2*1 

PRE 

TXI 

*  +  l ,4,-2 

SXA 

IR4 ,4 

SXA 

I R2  » 2 

SXA 

I R 1 , 1 

STZ 

CDCT 

NZT 

CLAUDE 

TRA 

*  +  3 

CLA 

2,4 

TRA 

LOCATE+5 

CLA* 

7,4 

STO 

ALPHA+4 

CALL 

•  F  V 1 0 • ( ALPHA+4, ALPHA  +  5) 

KRD00010 
KRD00020 
KRDOOO  30 
KRD00040 

krdooo^o 

KRD00060 
KRD00070 
KRDOOOBO 
KRDOOOVO 
KRD00100 
KRD001 10 
KRDOO 1 20 
KRD00130 
KRD0014Q 
KRDOO 1 30 
KRD00160 
KRDOO 170 
KRDOO 1 80 
KRDOO 1  VO 
KRD00200 
KRD002  iO 
KRD00220 
KRD00230 
KRD00240 
KRD002  50 
KRD00260 
KRD002  70 

KRD002  7 1 
KR  0002  7  2 
KR  D002  7  3 
KRD00274 
KRD002  7  5 
KRD00276 
KRD002  77 
KRD 00280 
KRD00290 
KRD00300 
KRD00310 
KRD003 15 
KRD00320 
KR  DOO  3  30 

KRD003  3 1 
KRD00332 
KRD00333 
KRD00340 
KRD00330 
KRD00360 
KRD00370 
KRD00380 
KR  D003  8  1 
KRD00382 
KRD00383 
KRD00384 
KRD00390 
KRD00400 
KRD00410 


CLA 

ALPHA+5 

STA 

ROPEN+l 

STA 

LOCATE+1 

STA 

LOCTWO+1 

PAC 

0*4 

LDI 

1*4 

LFT 

040000 

TRA 

LOCATE 

ROPEN 

TSX 

•  OPEN  *4 

MZE 

** 

LOCATE 

TSX 

•  READ  *4 

PZE 

**  *  *  ER1 1 

PZE 

ER 1  *  *  ER10 

IORTN 

»*.,  , ** 

CLA 

*-l 

STA 

LDQ 

STA 

ALOOP 

ADD 

=  11 

STA 

SETAD 

STA 

LAST-2 

LXA 

I  R4  *  4 

CLA* 

2*4 

STO 

TEST 

CLA 

BFILL 

STD 

BDEC 

CLA 

SWONE 

K.RDA 

STA 

SW 

AXT 

10*1 

SWALT 

PXA 

0.1 

STA* 

3.4 

CLA 

1*4 

STA 

STORE 

CLA* 

4*4 

STA 

XCA 

NFC 

CLA* 

5.4 

STO 

NCOL 

MPY 

XCA 

NCOL 

LXA 

ZERO. 4 

CAS 

=  72 

TRA 

ER2 

TXI 

*+1*4. -1 

SXA 

LAST  *  4 

AGAIN 

LXA 

=077777.4 

TOV 

*  +  l 

LXA 

NCOL  » 2 

SXD 

NFCC.4 

CAL 

=  017 

STD 

WDCT 

ST  Z 

PWR 

ANA 

** 

LAC 

NFC  *4 

LAST 

AXT 

***1 

TZE 

*  +  3 

AXT 

0.1 

PAC 

**  *4 

TXL 

I R4  *  4  *0 

SXD 

ALL-1  *  1 

SXD 

NFT.4 

KRD00420 

KRD00430 

KRD00440 

KRD00450 
KRD00460 
KRD00470 
KRD00480 
KRD00490 
KRD00500 
KRD00510 
KRD00520 
KRD00530 
<RD00540 
KRD005  50 
K.RD00560 
KRD00570 
KRD00580 
KRD00590 
KRD00600 
<R  0006 10 
KRD00620 
KRD00630 
KRD00640 
K.RD00630 
KRD00660 
KRD00670 
KRD00680 
KRD00690 
KKD00700 
KRD00710 
KRD00720 
KR000730 
KR000740 
KRD00750 
KRD00760 
KRD00770 
KKD00780 
KRD00790 
KRD00800 
<RD008 10 
KRD00820 
KRD00830 
KRD00S40 
KRD00850 
KRD00860 
KRD00870 
KRD00880 
KR000890 
KR000900 
K.RD00910 
KRD00920 
KRD00930 
KRD00940 
KRD00930 
KRD00960 
KRD00970 
KRD00980 
KRD00990 
KRD01000 
KRD01010 
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TXL 

*+2.4*-2 

STD 

NFCC 

BACK 

CLA 

* 

STD 

STAR1 

CLS 

CLS 

=  0 

STO 

ALPHA+1 

STO 

ALPHA+2 

LOOP 

LXD 

WDCT . 4 

LDO 

LDO 

**  .4 

AXT 

6.1 

BDEC 

TXI 

*+l *4.-1 

SXD 

WDCT *4 

ZERO 

PXD 

0.0 

LGL 

6 

SWONE 

PAX 

SW+1 l 4 

TXL 

NUM  »  4  »  9 

TXL 

ER4.4.15 

TXL 

NEXT. 4, 16 

TXL 

ER4.4.17 

TXL 

FIXED.4,18 

TXL 

ER4.4.20 

TXL 

FLOAT.4.21 

TXL 

ER4.4.26 

TXL 

POINT .4*27 

TXL 

ER4.4.31 

TXL 

MINUS. 4. 42 

TXL 

ER4.4.47 

TXL 

NEXT. 4. 48 

ER4 

AXT 

4.4 

TRA 

SCRAM 

ER1 

AXT 

1.4 

TRA 

SCRAM 

ER2 

AXT 

2.4 

TRA 

SCRAM 

ER5 

AXT 

5.4 

TRA 

SCRAM 

ER6 

AXT 

6.4 

TRA 

SCRAM 

ER7 

AXT 

7.4 

TRA 

SCRAM 

ER9 

AXT 

9.4 

TRA 

SCRAM 

ER10 

AXT 

10.4 

TRA 

SCRAM 

ER11 

AXT 

11.4 

SCRAM 

PXA 

0.4 

LXA 

IR4.4 

STO* 

3.4 

PXD 

0.0 

TRA 

IR2 

POINT 

STZ 

ALPHA+2 

TRA 

NEXT 

MINUS 

TXL 

NOTL.4.34 

TXH 

NOTL .4.35 

TXH 

NOTL.2.1 

LXA 

IR4.4 

CLA 

1  .4 

ADD 

=  1B17 

ADD 

ALPHA+1 

STA 

STORE 

ILLEGAL  CHARACTER 
END  OF  FILE 
CF  772 

SCALING  TOO  LARGE 
FL.  PT.  OVERFLOW 
FL.  EXP.  OUT  OF  RANGE 
ILLEGAL  CHAR.  COL.  72 


KRD01020 
KRD01030 
KR  DO 104Q 
KRD01050 
K.RD01060 
KRD01070 
KRDOioao 
XRD01090 
KR  DO  1 100 
KRDOlllO 
KRD011Z0 
KRD01 1 30 
KRDOlllO 
KRDOlllO 
KRD01160 
<RD01170 
KRD011«0 
KRD01190 
KRD01200 
KRD01210 
KRD01220 
KRD01230 
KRD012A0 
KRD01250 
KRD01260 
XRD01270 
KRD012&0 
KRD012V0 
KRD01300 
K.RDO  1  3  10 
KRD01320 
K.R  DO  1  3  30 
KRD013A0 
KRD013&0 
KRD01360 
KRD01370 
KRD013B0 
KRD013V0 
KRD01400 
KRD01410 
KRD01420 
KRD01430 
KRD01440 
KRD01450 
KRD01460 
KRD01470 
KKD014b0 
K.RD014V0 
K.RD01500 
KRD01510 
KRD01520 
KRD01530 
KR  DO  1540 
KRD01550 
KRD01560 
KRDO 1 5  7o 
KRD015B0 
KRD01590 
KRD01600 
KRD01610 


TRA 

NF 

NOTL  SUB 

=  040 

TXL 

*+2.4*42 

SUB 

=  10 

LXD 

CLS » 4 

SXD 

STAR1 *4 

NUM  STO 

ALPHA 

CLA 

ALPHA+1 

ALS 

3 

ADD 

ALPHA+1 

ADD 

ALPHA+1 

ADD 

ALPHA 

SSP 

TNO 

*  +  3 

AXT 

8.4 

CONVERSION  OVERFLOW 

TRA 

SCRAM 

STO 

ALPHA+1 

CLA 

ALPHA+2 

TMI 

NEXT 

CLA 

PWR 

SUB 

=  1 

STO 

PWR 

NEXT  TNX 

ENDFD.2.1 

T  I X 

ZERO . 1  .1 

TRA 

LOOP 

FIXED  BSS 

0 

FLOAT  SSM 

STO 

ALPHA+2 

XEC 

STAR1 

STO 

ALPHA+3 

CLA 

PT2 

STA 

NEXT 

CLA 

* 

STD 

STAR1 

CLS 

=  0 

STO 

ALPHA+1 

TRA 

NEXT 

PT2  PZE 

ENDEX 

PT1  PZE 

ENDFD 

ENDEX  CLA 

PT1 

STA 

NEXT 

LXA 

ALPHA+2  *4 

XEC 

STAR1 

T  I X 

ERTN.4.19 

3RTN  TNZ 

*  +  3 

TPL 

*+2 

CLA 

=  35 

SUB 

=  35 

TMI 

*  +  4 

TZE 

*  +  3 

ER3  AXT 

3.4 

NEGATIVE  SCALING 

TRA 

SCRAM 

STA 

SHIFT 

STO 

ALPHA+2 

LDQ 

ALPHA+3 

PXD 

0.0 

SHIFT  LLS 

** 

LXA 

PWR. 4 

DCT 

TRA 

*  +  l 

KRD01620 
XRD01630 
KRDO 1 640 
ICRD01650 
KRD01660 
KRD01670 
KRD01680 
KRD01690 
KRD01700 
KRD01710 
KRD01720 
KRD0i730 
ICRD01740 
KRD01750 
KRD01760 
ICRD01770 
XRD01780 
■CRD01790 
<RD01800 
ICRD01810 
ICRD01820 
KKD018J0 
KKD01840 
KR001850 
K.RD01860 
KRD01870 
KROO180O 
KRD01890 
KRD01900 
ICR  DO  1 9  10 
ICRD01920 
<RD01930 
ICRD01940 
K.RD01930 
KRD01960 
ICRD01970 
KRD01980 
ICRD01990 
KRD02000 
KRD020  10 
KRD02020 
ICRD02030 
XRD02040 
ICRD020^0 
ICRD02060 
ICRD02070 
KRD02080 
ICRD02090 
ICRD02100 
KRD02 1 10 
ICRD02120 
ICRD02 1 30 
ICRD02140 
KRD021&0 
KRD02160 
<RD02170 
KRD02180 
ICRD02190 
ICRD02200 
KRD02210 
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DVP 

DCT 

1 OT  •  4 

TRA 

ER5 

TOV 

ER3 

ALS 

1 

STO 

ALPHA 

LDQ 

* 

LAS 

NOP 

10T.4 

LOO 

MINUS 

CLA 

RND 

ALPHA 

TRA 

STORE 

£RTN 

ADO 

PWR 

STO 

PWR 

CLA 

ALPHA+3 

TRA 

*  +  2 

ENDFD 

BSS 

0 

STAR1 

CLA 

ALPHA+1 

STQ 

ALPHA+2 

TZE 

LFTM 

STORE 

LRS 

8 

TNZ 

*  +  3 

ORA 

=0232000000000 

TRA 

*  +  2 

ORA 

=0243000000000 

STO 

ALPHA 

CLA 

=0466000000 

LLS 

8 

FAD 

FRN 

ALPHA 

LXA 

PWR  * 4 

TXL 

XC  A 

SAVE  *4*0 

CLA 

PWR 

TXH 

ER7  » 4  *  38 

TMI 

DI  V 

FMP 

PWR10  *4 

TRA 

OUT 

01  V 

XCA 

FOP 

PWR 10  »4 

STQ 

ALPHA 

FDH 

PWR 10  #  4 

PXA 

OtO 

TOO 

XCA 

*  +  2 

FAD 

ALPHA 

OUT 

FRN 

TOV 

ER6 

SAVE 

EFTM 

STORE 

STO 

■** 

CLA 

STORE 

ADD 

I  NCR 

STA 

STORE 

LDQ 

ALPHA+2 

NF 

LXD 

NFCC.4 

TNX 

ALL  *4 • 1 

SXD 

NFCC  *  4 

CLA 

* 

KRD02220 
K.RD02230 
KRD02240 
XRD02230 
KRD02260 
KRD02270 
KRD02280 
KRD022V0 
KRD02300 
KRD02  3 10 
KRD02320 
KRD02330 
KRD023‘*0 
KRD023&0 
KRD02360 
KRD02370 
KRD02380 
KRD02390 
KRD02400 
XRD02410 
KRD02420 
KRD02430 
KRD02440 
KRD02430 
KRD02460 
KRD02470 
KRD02480 
KRD02490 
KRD02500 
KR002510 
KRD02520 
KRD02530 
KRD02540 
KRD02530 
KR002560 
KRD02570 
KRD02580 
KRD025V0 
KRD02600 
KRD02610 
KRD02620 
KRD02630 
KRD02640 
KRD02630 
KRD02660 
KRD02670 
KRD02680 
KR002690 
KRD02700 
KRD02710 
KRD02720 
KRD02  7  30 
KRD02740 
KRD027&0 
KRD02760 
KRD02770 
KRD02780 
KRD02790 
KRD02800 
KRD02810 


STD 

STAR1 

CLS 

=  0 

STO 

ALPHA+1 

STO 

ALPHA+2 

STZ 

PWR 

LXA 

NCOL  . 2 

NFT 

TXH 

NEXT+1 *4  *** 

STD 

NFCC 

TXI 

NEXT+1 *2  »-l 

ALL 

BSS 

0 

IRA 

AXT 

**  »  4 

SW 

TRA 

** 

CLA 

CDCT 

ADD 

=  1 

STO 

CDCT 

ZET 

CLAUDE 

TRA 

EXIT 

CLA* 

6.4 

PAX 

0.1 

TXL 

BLOOP.l.O 

LXD 

WDCT.2 

ALOOP 

CLA 

0.2 

XEC 

STORE 

CLA 

STORE 

ADD 

I  NCR 

STA 

STORE 

BFILL 

TXI 

*+1.2»-l 

T  I X 

ALOOP. 1*1 

SLOOP 

CLA 

TEST 

TZE 

EXIT 

SETAD 

CLA 

0 

ALS 

9 

PAX 

0.2 

TXH 

MTEST .2.8191 

loctwo 

TSX 

.READ. 4 

PZE 

**.  *ER11 

PZE 

ER 1 • . ER10 

IORTN 

**,,#* 

CLA 

*-l 

STA 

LDO 

STA 

ALOOP 

ADD 

=  11 

STA 

SETAD 

STA 

LAST-2 

TRA 

AGAIN 

MTEST 

TXH 

ER9. 2*24576 

TXH 

LOCTWO. 2. 24575 

TXH 

ER9.2. 13312 

EXIT 

PXD 

0.0 

STO* 

3.4 

IR2 

AXT 

** .  2 

IR1 

AXT 

**.l 

CLA 

CDCT 

TRA 

CART+1 

* 

#  #  # 

*  *  *  * 

******** 

* 

I  NCR 

PZE 

1 

ALPHA 

BSS 

6 

CLAUDE 

DEC 

0 

KRD02820 
KRD02830 
KRD02840 
KRD028&0 
KRD02860 
KRD02870 
K.RD02880 
ICRD02890 
KRD02900 
KRD02910 
KR002920 
KRD02930 
K.RD02940 
K.RD029&0 
KRD02960 
KRD0296 1 
KRD02962 
KRD02970 
KRD02980 
KRD02990 
K.RD03000 
K.RD03010 
<RD03020 
KR003030 
KRD030**0 
KRD03030 
KR003060 
KRD03070 
KRD03080 
KRD03090 
KRD03100 
KRD03U0 
KRD03120 
K.RD03 1 30 
KRD03140 
KRD031&0 
KRD03160 
KRD03170 
KRD03180 
KRD03190 
ICRD03200 
KRD032X0 
KR003220 
KRD032  30 
KRD03240 
KRD032&0 
KRD03260 
KRD03270 
KR003280 
KRD03290 
KRD03300 
KRD033  10 
ICR003320 
KRD03330 
KRD03340 
*  *  *  *  *  KRD03350 
KRD03360 
KRD03370 
KRD03380 

KRD0338 1 
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TEST 

NFC 

NFCC 

NCOL 

WDCT 

CDCT 

PWR 


10T 

ZPWRIO 


END 

PWRIO 


*  *  * 


BSS  1 

BSS  0 

BSS  1 

BSS  0 

BSS  1 

BSS  1 

BSS  1 

DEC  lOOOOOOOOO  *  10000*000* • 100000000 * 10000000 

DEC  1000000* 100000* 10000* 1000 t 100* 10 

PZE  1 

OCT  377454732313*373741367021*370601137164 
OCT  365464114135,361755023373,356612334311 
OCT  353473426555,347770675742,344623713116 
OCT  341503074077,336402374714,332635456171 
OCT  327512676456*324410545213,320647410336 
OCT  315522640262*312417031702*306661534466 
OCT  303532743536,300425434430*274674055532 
OCT  271543212741,266434157116*262706576512 
OCT  257553630410*254443023471,250721522450 
OCT  245564416672 ,242452013710*236734654500 
OCT  233575360400*230461132000*224750220000 
OCT  221606500000*216470400000*212764000000 
OCT  207620000000*204500000000*201400000000 
BSS  0 

SYN  END-1 

**************************** 

REM 

END 


KRD033Y0 
K.RD03400 
KRD03410 
KRD03420 
KRD03430 
KRD03440 
K.RD03450 
ICRD03460 
KRD03470 
KRDO340O 
KRD03490 
KRD03500 
KRD03510 
KRD03520 
K.RD03530 
KRD03540 
KRD03550 
KRD03560 
KRD03570 
KRDO350O 
KRD03590 
KRD03600 
KRD03610 
KRD03620 
<RD03630 
HRD03640 
*  *  *  *  *  KRD03650 
HRD03660 
K.RD036  70 
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SUBROUTINE  BSF 


SlBMAP  FBSF  100 »L 1ST . DECK »M94 
*  BACK-SPACE  FILE  SUBROUTINE  / 


BSF 


* 

* 

* 

* 

* 

* 

* 

* 

* 

# 

* 

* 

* 

* 

* 


*********************************** 
CALL  BSF  (NFILE.LTAPE  #L ERROR ) 

NFILE  -  NUMBER  OF  FILES  TO  BE  SPACED#  THE  TAPE  IS  ALWAYS 
LEFT  POSITIONED  AT  THE  BEGINNING  OF  SOME  FILE# 

0  MEANS  BACKSPACE  TO  BEGINNING  OF  CURRENT  FILE# 

1  MEANS  BACKSPACE  TO  BEGINNING  OF  PRECEDING  FlLEf 
ETC. 

LTAPE  *  LOGICAL  TAPE  UNIT  TO  BE  USED. 

LERROR  -  LOCATION  IN  WHICH  ERROR  CODE  IS  TO  BE  STORED. 

0  INDICATES  SUCCESS. 

N  INDICATES  NUMBER  OF  FILES  NOT  SPACED  WHEN 
BEGINNING  OF  TAPE  WAS  REACHED. 

************************************ 

REM 
LDIR 
REM 
REM 


#  *  * 

BSF 


SETA 

CONT 


•  *  *  « 

*  #  *  *  * 

SAVE 

4  *  2  »  1  #  I 

CLA* 

4.4 

STO 

TEMP 

CALL 

•FVIO. ( T 

CLA 

TEMP+1 

STA 

SETA 

STA 

SETB 

LX  A 

..0001.4 

CLA* 

3.4 

PAX 

0.1 

TXI 

*+1.1.1 

LAC 

TEMP+1. 2 

LDI 

1.2 

LNT 

040000 

TRA 

SETA+1 

TSX 

.CLOSE. 4 

MON 

** 

TSX 

•NDSEL.4 

PZE 

0.2.6 

AXC 

2.4 

N2T* 

0.2 

TRA 

SETN 

TlX 

CONT .1.1 

AXT 

WAIT. 4 

SXA 

WAIT. 4 

CLA 

0.2 

PAC 

0.1 

ZET 

1.1 

TRA 

*-l 

LDQ 

SETWD 

STQ 

1.1 

TSX 

•ACTV.4 

MZE 

0.2 

•  * 


BSF00010 
BSFOOO^O 
BSFOOO&O 
BSF00060 
BSF00070 
BSF00080 
BSF00090 
BSF  00 100 
BSFOOHO 
BSFOOl^O 
BSF  00130 
BSF00140 
BSF001&0 
BSF00160 
BSF00170 
BSF00180 
BSF00190 
BSF00200 
BSF00210 
BSF00220 
BSF00230 
BSF002<*0 
BSF00250 
BSF00260 
BSF00270 
BSF00280 
BSF00290 
BSF00300 
BSF00310 
BSF00320 
BSF00330 
BSF00340 
BSF003t>0 
BSF  00360 
BSF00370 
BSF00380 
BSF00390 
BSF00400 
BSF00410 
BSF00420 
BSF00430 
BSF00440 
BSF004&0 
BSF00460 
BSF00470 
BSF00480 
BSF00490 
BSF00500 
8SF00510 
BSF00520 
BSF00530 
BSF00540 
BSF005&0 
BSF00560 
BSF00570 
BSF00580 
BSF00590 
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WAIT 

TRA 

* 

SETWD 

TWO 

COM ..SELRT 

COM 

IORT 

TEMP+4  *  *  10 

MPC 

LXA 

..0001*4 

STZ* 

5.4 

MPCA 

TSX 

. OPEN. 4 

SETB 

MON 

** 

RETURN 

BSF 

SETN 

TXI 

•+1.1.-1 

PXA 

0.1 

LXA 

..0001*4 

S?TO* 

5*4 

TRA 

MPCA 

SELRT 

TPL 

SELPL 

AXT 

MPC. 2 

SXA 

WAIT.2 

PAC 

0.2 

STZ 

1.2 

TRA 

1.4 

SEL.PL 

PAC 

0.2 

CLA 

1.2 

STA* 

•  RCHX 

TRA 

REM 

LORG 

1.4 

*  *  ■ 

*  *  *  * 

****** 

ERASE 

CONTRL 

ER 

USE 

ER 

TEMP 

BSS 

END 

20 

BSF00600 
BSF00610 
BSF00620 
BSF00630 
BSF00640 
BSF00650 
BSF00660 
BSF00670 
BSF00680 
BSF00690 
BSF00700 
BSF00710 
BSF00720 
BSF00730 
BSF00740 
BSF00750 
BSF00760 
BSF00770 
BSF00780 
BSF00790 
BSF00800 
BSF00810 
BSF008  70 
BSF00880 
BSF00890 

*******************  BSF00900 

BSF00910 

BSF00920 

BSF00930 

BSF00940 

BSF00950 
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SUBROUTINE  FSF 


*•*••• 


S I BMAP  FFSF  50.DECK.M94 

♦FSF  709/90  FORTRAN  LIBRARY  /  FORWARD  SPACE  FILE 

♦ 

***#*#*♦♦♦♦*♦******** 

♦ 

♦  CALL  FSF  (NFILE.LTAPE  »L ERROR ) 

♦ 

♦  NFILE 

♦ 

♦  LTAPE 

♦  LERROR 

♦ 

♦ 

♦ 

♦ 


♦  ♦♦♦♦♦♦♦ 


number  of  end-of-file  marks  TO  SPACE  PASS. 

ZERO  IS  EQUIVALENT  TO  ONE. 

LOGICAL  TAPE  NUMBER. 

LOCATION  IN  WHICH  THE  ERROR  CODE  IS  STORED. 

0  INDICATES  SUCCESS. 

N  INDICATES  NUMBER  OF  UNSPACED  FILES  WHEN 

END-OF-TAPE  SIGNAL  WAS  REACHED  ISEE  MM-23). 


♦  ♦ 

♦  ♦  ♦  ♦ 

REM 

LOIR 

REM 

REM 

***** 

♦  ♦ 

♦  ♦  ♦  • 

***** 

FSF 

SAVE 

(4.2.1 ) I 

CLA* 

4.4 

STO 

TEMP 

CLA* 

3.4 

PAX 

0.1 

CALL 

•  F V 10  .  (  Tl 

LAC 

TEMP+1 .2 

LDI 

1.2 

CLA 

TEMP+1 

STA 

SETA 

STA 

SETX 

LFT 

040000 

TRA 

LOOP 

TSX 

.OPEN. 4 

SETX 

MON 

** 

LOOP 

TSX 

•READ. 4 

SETA 

PZE 

**.  .0 

PZE 

EOF. .ERR 

IOCP 

SKIM. 0.2 

IORTN 

**.0.“1 

ERR 

CAL 

SKIM+1 

LAS 

CODE 

TRA 

LOOP 

TRA 

ERRA 

TRA 

LOOP 

EOF 

T  I X 

LOOP. 1.1 

LXA 

••0001.4 

STZ* 

5.4 

RETURN 

FSF 

ERRA 

PXA 

0.1 

LXA 

••0001.4 

STO* 

5.4 

TRA 

ERRA-1 

CODE 

BCI 

LORG 

1. TAPEND 

ERASE 

CONTRL 

ER 

♦  ♦♦♦♦♦♦♦ 


*♦*#♦***♦♦♦♦♦*♦* 


♦  ♦•♦♦♦♦ 


*♦*♦#♦♦♦*♦♦*♦♦♦** 


LOGICAL  UNIT 
CTR  TO  XR1 


READ  TO  EOF 


IF  TAPEND 


SET  N«0 

SET  N  TO  CTR  OF 
UNSKIPPED  FILES 


FFSFOOlO 
FFSF0020 
FFSF00&0 
FFSF0060 
FFSF0070 
FFSF0060 
FFSF0090 
FFSF0100 
FFSF01 10 
FFSF0120 
FFSF0I30 
FFSFOl^O 
FFSF01&0 
FFSF01&0 
FFSFO 1 70 
FFSF0180 
FFSF0190 
FFSF0200 
FFSF0210 
FFSF0220 
FFSF0230 
FFSF02A0 
FFSF0230 
FFSF0260 
FFSF02  70 
FFSF0280 
FFSF0290 
FFSF0300 
FFSF0310 
FFSF0320 
FFSF0330 
FFSF03A0 
FFSF03  30 
FFSF0360 
FFSF0370 
FFSF0380 
FFSF0390 
FFSF0400 
FFSF0410 
FFSF0420 
FFSF0430 
FFSF0440 
FFSF0430 
FFSF0460 
FFSF0470 
FFSF0480 
FFSF0490 
FFSF0500 
FFSF05I0 
FFSF0520 
FFSF0530 
FFSF0540 
FFSF0530 
FFSF0560 
FFSF0570 
FFSF0580 
FFSF0590 
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SUBROUTINE  FSR 


SlBMAP  FFSR  50 # L I  ST . DECK »M94 

*  FORWARD  SPACE  RECORD  /  FSR 


*********************** 
CALL  FSR  ( NREC *LTAPE tLERROR ) 


•  ****«••***• 


# 

* 

* 

* 

« 

* 

* 

* 

* 

* 

* 

* 

**»**«• 


NREC  -  NUMBER  OF  FORTRAN  LOGICAL  RECORDS  TO  SPACE  FORWARD. 
LTAPE  -  LOGICAL  TAPE  NUMBER. 

LERROR  -  LOCATION  IN  WHICH  THE  ERROR  CODE  IS  STORED. 

0  INDICATES  SUCCESS. 

N  indicates  number  of  unspaced  records  when  an 
END-OF-FILE  mark  was  found,  tape  left  spaced  in 

FRONT  OF  EOF. 

CALL  FSPRINPREC.LTAPE. LERROR) 

NPREC  -  NUMBER  PHYSICAL  RECORDS  TO  SPACE  FORWARD. 


REM 

ENTRY 

FSR 

ENTRY 

FSPR 

REM 

REM 

FSPR 

LDIR 

STZ 

CODE 

TRA 

*  +  2 

FSR 

STL 

CODE 

TURN 

SAVEN 

4.2.1  .1 

CLA* 

4.4 

STO 

TEMP 

CLA* 

3.4 

PAX 

0.1 

TZE 

WIND 

CALL 

.FVIO.  (TEI 

LAC 

TEMP+1 .2 

SCA 

SETA. 2 

SCA 

SETB. 2 

LDI 

1.2 

LFT 

040000 

TRA 

READL 

TSX 

.OPEN. 4 

SETB 

MON 

** 

READL 

TSX 

.READ .4 

SETA 

PZE 

**.  .0 

PZE 

EOF,, ERR 

IOCP 

SKIM.0,2 

IORTN 

**,0»-l 

ERR 

LXA 

SKIM, 4 

ZET 

CODE 

TXL 

READL, 4,0 

T  IX 

READL, 1.1 

PXD 

0,0 

DONE 

LXA 

..0001,4 

STO* 

5,4 

M3 


FSR00010 
FSR00020 
FSR00060 
FSR00070 
FSR00080 
FSR00090 
FSROOIOO 
FSR00U0 
FSR00120 
FSROO130 
FSR00140 
FSR00150 
FSR00160 
FSR00170 
FSR00160 
FSR00190 
FSR00200 
FSR00210 
FSR00220 
F  SR002  30 
FSR00240 
FSR00250 
FSR00260 
FSR00270 
FSR00280 
FSR00290 
FSR00300 
FSR003I0 
FSR00320 
FSR00330 
FSR00340 
FSR00350 
FSR00360 
FSR00370 
FSR00380 
FSR00390 
FSR00400 
FSR00410 
FSR00420 
FSR00430 
FSR00440 
FSR  00450 
FSR00460 
FSR00470 
FSR00480 
FSR00490 
FSR00500 
FSR00510 
FSR00520 
FSR00530 
FSR00540 
FSR005S0 
FSR00560 
FSR00570 
FSR00580 
FSR00590 
FSR00600 
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RETURN 

TURN 

FSR00610 

EOF 

TSX 

«NDSEL  #4 

F  SR  00620 

PZE 

0*2*5 

FSR00630 

NOP 

FSR  006^*0 

WIND 

PXA 

0*1 

FSR00650 

TRA 

DONE 

FSR00660 

* 

FSR00670 

« 

FSR00690 

ERASE 

CONTRL 

ER 

FSR00700 

USE 

ER 

FSR00710 

TEMP 

BSS 

2 

FSR00720 

SKIM 

BSS 

2 

FSR00730 

CODE 

BSS 

1 

FSR007A0 

BSS 

15 

FSR00750 

# 

FSR00760 

REM 

FSR00780 

END 

FSR00790 
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APPENDIX  H 


SUBROUTINES  READTP,  WRTETP,  FVIO,  FILE,  INRPRD,  AND  FRUN 

1.  SUBROUTINE  READTP  DESCRIPTION 

Subroutine  READTP  reads  a  binary  tape  in  the  format  of  the  7094  matrix 

interpretive  scheme  (TL01). 

Subroutine  READTP  has  the  following  restrictions: 

•  The  matrix  on  tape  must  be  written  by  subroutine  WRTETP,  a  TL01  pro¬ 
gram,  or  its  equivalent. 

•  Tape  spacing  subroutines  FSF,  FSR,  and  BSF  are  used  by  READTP. 

•  Tape  reading  is  done  by  FORTRAN  IV  I/O  subroutines. 

•  Only  one-  or  two-dimensional  arrays  can  be  written  on  tape, 
a.  Calling  Sequence 

The  calling  sequence  and  descriptions  of  the  READTP  arguments  are  as 

follows: 

Parameter  Function 

A  (1, 1)  element  of  the  matrix  to  be  read  from  tape.  If  this  is  not 

A(l,  1),  the  designated  submatrix  is  read.  (This  is  a  method 
of  departitioning  matrices  as  they  are  read  from  tape. ) 

K  Row  DIMENSION  statement  entry  for  A.  This  must  be  1  if  A  is 

a  singular  dimensioned  variable. 

NAME  Name  of  matrix  as  it  is  read  from  tape.  If  NAME  is  nonzero 

upon  entry  to  READTP,  the  name  coming  from  the  tape  is  compared 
to  the  incoming  NAME  and,  if  there  is  no  agreement,  an  error 
return  occurs.  If  the  two  names  are  the  same,  the  name  from 
the  tape  is  stored  in  NAME. 

M  Number  of  rows  in  the  matrix 

N  Number  of  columns  in  the  matrix 

B  Words  5  through  16  of  the  1610-word  matrix  identification 
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Parameter 


Function 


NFILE  Number  of  file  marks  to  be  passed  before  reading  starts.  If  0, 

no  file  spacing  takes  place.  If  negative,  backspacing  occurs  and 
NFILE  end-of-file  marks  are  passed.  Then,  the  tape  is 
spaced  forward  and  past  the  last  file  mark  encountered.  The 
tape  is  always  at  the  beginning  of  a  file  after  any  file  spacing. 

NMAT  Number  of  matrices  to  be  passed  before  reading  starts.  If  0,  no 

matrix  spacing  takes  place.  A  negative  value  is  illegal,  because 
backward  spacing  of  matrices  is  not  allowed.  All  matrix  spacing 
takes  place  after  file  spacing  is  complete. 


NTAPE  Logical  tape  number 

IRROR  0  if  successfully  read;  1  if  file  spacing  error;  2  if  matrix  spacing 

is  negative;  3  if  matrix  spacing  error;  4  if  checksum  error; 

5  if  name  on  tape  is  wrong 

b.  Space  Required 

Subroutine  READTP  requires  330  cells.  Also,  134  cells  of  storage  are 
required  for  subroutines  FSR,  FSF,  and  BSF. 

c.  Tape  Format 

The  matrix  must  be  written  in  two  FORTRAN  logical  records.  This  is 
automatically  satisfied  if  the  tape  is  written  by  WRTETP  or  TL01. 

2.  SUBROUTINE  WRTETP  DESCRIPTION 

Subroutine  WRTETP  writes  a  matrix  on  binary  tape  in  a  format  consistent 
with  the  7094  matrix  interpretive  scheme  (TL01). 

This  subroutine  has  the  following  restrictions: 

•  The  matrix  must  be  in  the  core  in  normal  FORTRAN  IV  order. 

•  Tape  spacing  subroutines  FSF,  FSR,  and  BSF  are  used  by  subroutine  WRTETP. 

•  Tape  writing  is  done  by  FORTRAN  IV  I/O  subroutines. 

•  Only  one-  or  two-dimensional  arrays  can  be  written  on  tape. 
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a.  Calling  Sequence 

The  calling  sequence  and  descriptions  of  the  READTP  arguments  are 
as  follows: 

Parameter  Function 


A 

(1, 1)  element  of  the  matrix  to  be  written  on  tape.  If  this  is 
not  A(l,  1),  then  the  designated  submatrix  is  put  on  tape. 

K 

Row  DIMENSION  statement  entry  for  A.  This  is  1  if  A  is  a 

singular  dimensioned  variable. 

NAME 

Name  of  the  matrix;  a  fixed-point  number 

M 

Number  of  rows  in  the  matrix 

N 

Number  of  columns  in  the  matrix 

B 

Words  11  through  16  of  16^q  -word  matrix  identification 

NFILE 

Number  of  end-of-file  marks  to  be  passed  before  writing  starts. 

If  0,  no  file  spacing  takes  place.  If  negative,  backspacing 

occurs  and  NFILE  end-of-file  marks  will  be  passed.  Then,  the 

tape  will  be  spaced  forward  and  past  the  last  file  mark  encoun¬ 
tered.  The  tape  is  always  at  the  beginning  of  a  file  after  any 

file  spacing. 

NMAT 

Number  of  matrices  to  be  passed  before  writing  occurs.  If  0, 

no  matrix  spacing  takes  place.  A  negative  value  is  illegal, 

because  backward  spacing  of  matrices  is  not  allowed.  All 

matrix  spacing  takes  place  after  file  spacing  is  complete. 

NTAPE 

Logical  tape  number 

IRROR 

0  if  successfully  written;  1  if  error  occurs  during  file  spacing; 

2  if  matrix  spacing  is  negative;  3  if  error  occurs  during  matrix 

spacing 

b.  Space  Required 

Subroutine  WRTETP  requires  431  cells.  Also,  134  cells  of  storage  are 
required  for  subroutines  FSR,  FSF,  and  BSF. 
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c.  Tape  Format 

The  matrix  consists  of  two  FORTRAN  logical  records.  The  first  of  these 
is  the  16^0  -word  identification,  and  the  second  consists  of  the  matrix  elements. 
The  matrix  may  be  written  in  fixed  point,  sparse,  or  null  forms. 


3.  SUBROUTINE  LISTINGS 


This  section  contains  the  following  subroutine  listings. 
Subroutine 

READTP . 

WRTETP  . 

FVIO . 

FILE . 

INRPRD . 

FRUN . 


Page 

243 

247 

252 

254 

255 
257 


The  following  is  a  description  of  subroutines  FVIO,  FILE,  INRPRD,  and 
FRUN: 

Subroutine  Function 

FVIO  This  subroutine  is  the  input/ output  statement  specifying  variable- 

output  units  1  through  17. 

FILE  The  FILE  definitions  of  units  1  through  17  are  computed  by  this 

subroutine. 

INRPRD  This  subroutine  computes  the  interproducts  of  two  matrices. 
FRUN  This  is  the  subroutine  that  rewinds  and  unloads  tapes. 
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*  O' 


SUBROUTINE  READTP 


SIBMAP  READTP 
•READTP 

# 

* 

* 

* 

* 

# 

# 


300  »M94/2  *DECK 

SUBROUTINE  TO  READ  A  TL-01  BINARY  TAPE 

FROM  A  FORTRAN  PROGRAM 

CALL  READTP  ( A *K *NAME *M .N • 8 *NF I LE tNMAT *NTAPE » IRR ) 

A  *=  ADDRESS  WHERE  MATRIX  IS  TO  BE  STORED 
K  ■  ROW  DIMENSION  STATEMENT  ENTRY  FOR  A 
NAME  ■  NAME  OF  MATRIX 
M  ■  ROW  SIZE  OF  MATRIX 
N  ■  COLUMN  SIZE  OF  MATRIX 
B  »  WORDS  5  THROUGH  16  OF  TAPE  ID 
NFILE  -  NUMBER  OF  FILES  TO  BE  SPACED 
FROM  CURRENT  POSITION 
POSITIVE  CAUSES  FORWARD  SPACE 
NEGATIVE  CAUSES  BACKWARD  SPACE 
NM AT  -  NUMBER  OF  MATRICES  TO  BE  SPACED 
FROM  CURRENT  POSITION 
NTAPE  -  LOGICAL  TAPE  NUMBER 
IRR  -  0  IF  READ  IS  SUCCESSFUL 

-  1  IF  FILE  SPACING  ERROR 

.  2  IF  MATRIX  SPACING  IS  NEG. 

-  3  IF  MATRIX  SPACING  ERROR 

-  4  IF  CHECKSUM  ERROR 

-  5  IF  NAME  ON  TAPE  IS  WRONG 


EADTP  SAVE 
SXA 
STZ 
CLA» 
STO 
CLA* 
STO 
CLA* 
TZE 
TPL 
SSP 
SUB 
STO 
CALL 
TRA 

FSFILE  STO 
CALL 

TESTFL  ZET 
TRA 

RCDSP  LXA 
CLA« 
TZE 
TMI 
ALS 
STO 
CALL 
ZET 
TRA 

REAOID  CALL 
CALL 
TSX 
STO 
LXA 


(1* 2*4)1 

XR4  »  4 

TESTC2 

5*4 

TEMPI 

11  »4 

TAPE 

9*4 

RCDSP 

FSFILE 

BACKSPACE 

-1 

MFILE 

BSF(MFILE*TAPE*IRR1 ) 

TESTFL 

MFILE 

FSF(MFILE*TAPE*IRR1 ) 

IRR1 

FILEER  FILE  SPACING  ERROR 

XR4*4 

10*4 

READID 

RCDER1 

MMAT  NUMBER  OF  LOGICAL  RECORDS. 

FSR (MMAT.TAPE* IRR1 I 

IRR1 

RCDER2  RECORD  SPACING  ERROR 

»FVIO»  (TAPE*TAPIB) 

.FRDB. (TAPIBJ 
.FBLT..4 
CNAME 
XR4»2 


oooooooo 

00000001 

00000002 

00000003 

00000004 

00000005 

00000006 

00000007 

00000006 

00000009 

00000010 

OOOOOOH 

00000012 

00000013 

00000014 

00000015 

00000016 

00000017 

ooooooie 

00000019 

00000020 

00000021 

00000022 

00000023 

00000024 

00000025 

00000026 

00000027 

00000026 

00000029 

00000030 

00000031 

00000032 

00000033 

00000034 

00000035 

00000036 

00000037 

00000038 

00000039 

00000040 

000000*1 

00000042 

00000043 

00000044 

00000045 

00000046 

00000047 

000000*8 

00000049 

00000030 

00000031 

00000032 

00000033 

00000034 

00000035 

00000036 
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STO* 

5.2 

NAME 

00000057 

TSX 

.FBLT  #  #4 

000000&8 

STO 

CM 

00000059 

STO* 

6  #  2 

M 

00000060 

TSX 

.FBLT. *4 

00000061 

STO 

CN 

00000062 

STO* 

7.2 

N 

00000063 

TSX 

.FBLT. .4 

00000064 

STO 

CSUM 

CHECKSUM 

00000065 

AXT 

12.1 

00000066 

CLA 

8.2 

B 

00000067 

ADD 

=  12 

00000068 

STA 

*  +  2 

00000069 

PNT1 

TSX 

.FBLT. .4 

00000070 

STO 

**  .  1 

LAST  12  NOS.  INTO 

B 

00000071 

T  I X 

PNT1.1.1 

00000072 

LDQ 

CM 

00000073 

MPY 

CN 

00000074 

STO 

MTN 

00000075 

CALL 

•  FRLR • 

00000076 

CLA 

TEMPI 

NAME  SUPPLIED  BY  CALLING  PROGRAM 

00000077 

TZE 

NULOSP 

IF  IT  IS  ZERO.  DO 

NOT 

CHECK 

00000078 

SUB* 

5.2 

DO  THE  NAMES  AGREE 

00000079 

TNZ 

NAMEER 

NO 

00000080 

NULOSP 

CLA* 

8.2 

00000081 

CAS 

WDMSP 

00000082 

TRA 

*  +  2 

00000083 

STO 

TESTC2 

MATRIX  SPARSE 

00000084 

READ 

CALL 

•FRDB. (TAPIS) 

00000085 

AXT 

1.2 

00000086 

LXA 

XR4.4 

00000087 

CLA 

3.4 

A 

00000088 

STA 

REDE 

00000089 

CLA* 

6.4 

00000090 

ALS 

18 

00000091 

STD 

TEST2 

M 

00000092 

STD 

TEST4 

00000093 

STD 

TEST  6 

00000094 

CLA* 

4.4 

K 

00000095 

PAC 

0.1 

00000096 

SXD 

TEST1-1.1 

00000097 

SXD 

TEST3-1.1 

00000098 

SXD 

TESTS- 1 . 1 

00000099 

XCA 

00000100 

MPY* 

7.4 

N 

00000101 

XCA 

00000102 

PAC 

0.1 

00000103 

SXD 

TEST1 .1 

-K*N 

00000104 

SXD 

TEST3.1 

00000105 

SXD 

TEST5.1 

00000106 

AXT 

0.1 

00000107 

PXA 

0.0 

00000108 

• 

START  CHECKSUM 

1  OFF  WITH  NAME  AND 

DIMENSIONS 

00000109 

ACL 

cname 

NAME  IN  ADDRESS 

OOOOOHO 

ACL 

CM 

M  IN  ADDRESS 

000001U 

ACL 

CN 

N  IN  ADDRESS 

00000112 

SLW 

TEMP 

STORE  SUM  IN  CELL 

FOR 

UPCOMING  CHECKSUM 

00000113 

NZT 

TESTC2 

00000114 

TRA 

REDEN 

00000115 

ACL 

WDMSP 

00000116 
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SLW 

TEMP 

00000117 

REDES 

TSX 

•  FBLT  •  ,4 

SPARSE  MATRIX 

oooooiie 

STO* 

REDE 

00000119 

PDX 

0  •  4 

00000120 

XCA 

GET  LOGICAL  VERSION  FOR 

CXSUM 

00000121 

XCL 

00000122 

ACL 

TEMP 

00000123 

SLW 

TEMP 

00000124 

TXL 

*+3*4*0 

00000125 

AXT 

0*4 

STORE  NO  ZEROS 

00000126 

TRA 

TEST3-1 

00000127 

CLA* 

REDE 

00000128 

PAX 

0*4 

00000129 

STZRO 

STZ* 

REDE 

STORE  ZEROS 

00000130 

TXI 

*+1.1*** 

-X 

00000131 

TEST  3 

TXH 

TIR4.1 *** 

-X*N 

00000132 

PXD 

0,2 

00000133 

PDC 

0.1 

00000134 

TXI 

*+1*2*1 

00000135 

TEST4 

TXL 

T I R4 , 2  *** 

M 

00000136 

TRA 

RLR 

TR  TO  RLR 

00000137 

TIR4 

T  I X 

STZRO *4*1 

00000138 

TRA 

REDES 

READ  NEXT  WORD 

00000139 

REDEN 

TSX 

.FBLT • .4 

TEST  FOR  NULL  MATRIX 

00000140 

NZT 

MTN 

00000141 

TRA 

RLR 

00000142 

STO* 

REDE 

000001+3 

LDQ* 

REDE 

00000144 

SUB 

WDMNL 

000001+5 

TZE 

*  +  3 

NULL 

000001+6 

XCL 

NOT  NULL 

000001+7 

TRA 

REDE1 

000001+8 

XCL 

000001+9 

ACL 

TEMP 

00000150 

SLW 

TEMP 

00000151 

STZN 

STZ* 

REDE 

000001&2 

TXI 

*  +  l *  1 *** 

-X 

00000153 

TEST5 

TXH 

ST  ZN  *  1 , ** 

-X*N 

00000154 

PXD 

0,2 

00000155 

PDC 

0*1 

00000156 

TXI 

*+1.2*1 

00000157 

TEST  6 

TXL 

STZN. 2,** 

M 

00000158 

TRA 

RLR 

00000139 

TSX 

.FBLT. ,4 

00000160 

REDE 

STO 

***1 

A 

00000161 

XCA 

GET  LEGICAL  VERSION  FOR 

CXSUM 

00000162 

XCL 

00000163 

EDE1 

ACL 

TEMP 

00000164 

SLW 

TEMP 

00000165 

TXI 

*+1*1 *** 

-X 

00000166 

TESTl 

TXH 

REDE-1. 1,*» 

-X*N 

00000167 

SXD 

TEMPI, 2 

00000168 

LDC 

TEMPI. 1 

00000169 

TXI 

*+1,2,1 

00000170 

TEST  2 

TXL 

REDE-1 ,2,** 

M 

00000171 

RLR 

CALL 

•  FRLR  * 

00000172 

CLA 

CSUM 

00000173 

TZE 

XR4 

IF  CSUM-0*  DO  NOT  CHECX 

00000174 

SUB 

=  1  • 

00000175 

TZE 

XR4 

00000176 
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CAL 

CSUM 

ERA 

TEMP 

TNZ 

CSUMER 

XR4 

AXT 

**  *4 

STZ* 

12*4 

RETURN 

READTP 

FILEER 

CLA 

*1 

LXA 

XR  4  *  4 

STO* 

12*4 

RETURN 

READTP 

RCDER1 

CLA 

“2 

TRA 

FILEER+1 

RCDER2 

CLA 

=  3 

TRA 

FILEER+1 

CSUMER 

CLA 

•4 

TRA 

FILEER+1 

nameer 

CLA 

■5 

TRA 

FILEER+1 

WDMNL 

BCI 

1  ,M-NULL 

WDMSP 

BCI 

1, SPARSE 

TESTC2 

PZE 

MTN 

PZE 

TAPE 

HTR 

0 

IRR1 

HTR 

0 

TEMP 

HTR 

0 

TEMPI 

HTR 

0 

CSUM 

HTR 

0 

MFILE 

HTR 

0 

MMAT 

HTR 

0 

CNAME 

PZE 

0 

CM 

PZE 

0 

CN 

PZE 

0 

TAP  IB 

PZE 

END 

ZERO  ERROR  CODE 
FILE  SPACING  ERROR 

NEGATIVE  MATRIX  SPACING 
MATRIX  SPACING  ERROR 
CHECKSUMS  DO  NOT  AGREE 
NAMES  DO  NOT  AGREE 


TAPE  FOR  IBSYS 


000001V7 
00000178 
00000179 
00000180 
00000 1 B 1 
00000182 
00000183 
00000184 
00000185 
00000186 
00000187 
00000188 
00000189 
00000190 
00000191 
00000192 
00000193 
00000194 
00000195 
00000196 
00000197 
00000198 
00000199 
00000200 
00000201 
00000202 
00000203 
00000204 
00000205 
00000206 
00000207 
00000208 
00000209 
00000210 
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SUBROUTINE  WRTETP 


SlBMAP  WRTETP 
♦WRTETP 
♦ 

♦ 

♦ 


♦ 

♦ 

♦ 

♦ 

♦ 

♦ 

* 

♦ 

♦ 

♦ 

♦ 

♦ 

♦ 

♦ 


400*M94/2*DECK 

SUBROUTINE  TO  WRITE  A  TL-01  BINARY  TAPE 

FROM  A  FORTRAN  PROGRAM. 

CALL  WRTETP  <A*K*NAME*M*N*B*NFILE*NMAT *NTAPE* IRR) 

A  *  ADDRESS  OF  MATRIX  (1*1)  ELEMENT 

ROW  DIMENSION  STATEMENT  ENTRY  FOR  A 
NAME  *  NAME  OF  MATRIX 
M  *  ROW  SIZE  OF  MATRIX 
N-COLUMN  SIZE  OF  MATRIX 
BYWORDS  11  THROUGH  16  OF  ID 
NFILE-NUMBER  OF  FILES  TO  BE  SPACED 
FROM  CURRENT  POSITION 
POSITIVE  CAUSES  FORWARD  SPACE 
NEGATIVE  CAUSES  BACKWARD  SPACE 
NMAT-NUMBER  OF  MATRICES  TO  BE  SPACED 
FROM  CURRENT  POSITION 
NTAPE-LOGICAL  TAPE  NUMBER 
IRR-  0  IF  SUCCESSFUL  WRITE 

=  1  IF  ERROR  ON  FILE  SPACE 
.  2  IF  MATRIX  SPACING  IS  NEGATIVE 
-  3  IF  ERROR  ON  MATRIX  SPACE 


WRTETP 

SAVE 

( 1 *2*4) I 

SX  A 

XR4*4 

CLA* 

11*4 

NT  APE 

STO 

TAPE 

CLA* 

9*4 

NFILE 

TZE 

RCDSP 

TPL 

FSFILE 

SSP 

BACKSPACE 

SUB 

-1 

STO 

MFILE 

CALL 

BSF(MFILE.TAPE*IRR1) 

TRA 

TESTFL 

FSFILE 

STO 

MFILE 

CALL 

FSF(MFILE*TAPE*IRR1) 

TESTFL 

ZET 

IRR1 

FILE  SPACING  ERROR 

TRA 

FILEER 

RCDSP 

LXA 

XR4*4 

CLA* 

10*4 

NMAT 

TZE 

CALCSM 

TMI 

RCDER1 

ALS 

1 

NUMBER  OF  LOGICAL  RECORDS 

STO 

MMAT 

CALL 

FSR 1 MMAT  *T  APE 

• IRR1 ) 

ZET 

IRR1 

RECORD  SPACING  ERROR 

TRA 

RCDER2 

CALCSM 

LXA 

XR4  *  4 

STZ 

TESTC1 

STZ 

TESTC2 

CLA 

WDSPSE 

STO 

TESTC3 

• 

TESTC3 -SPARSE *MATR IX  SPARSE 

♦ 

TESTC3-0* MATRIX  NOT  SPARSE 

CLA* 

3.4 

TEST  ELEMENT  A(l.l) 

CAS 

WDMNL 

TRA 

*■*■2 

OOOOOOOO 

00000001 

00000002 

00000003 

00000004 

00000005 

00000006 

00000007 

00000008 

00000009 

ooooooio 

OOOOOOU 

00000012 

00000013 

00000014 

00000015 

00000016 

00000017 

00000018 

00000019 

00000020 

00000021 

00000022 

00000023 

00000024 

00000025 

00000026 

00000027 

00000028 

00000029 

00000030 

00000031 

00000032 

00000033 

00000034 

00000035 

00000036 

00000037 

00000038 

00000039 

00000040 

00000041 

00000042 

00000043 

00000044 

00000045 

00000046 

00000047 

00000048 

00000049 

00000030 

00000031 

00000032 

00000033 

00000034 

00000035 

00000036 
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STO 

TESTC1 

ELEMENT  AI1.1)  =M«NULL 

CLA 

3.4 

STA 

CSM  1 

CLA* 

6.4 

SLW 

CM 

SAVE  M  IN  ADDRESS 

ALS 

18 

STD 

TST2 

STD 

TST4 

STD 

TST6 

STD 

TST8 

CLA* 

4.4 

X 

PAC 

0.1 

SXD 

TS  T 1-1  .1 

SXD 

TST3-1.1 

SXD 

TST  5- 1 » 1 

SXD 

TST7-1.1 

XCA 

MPY* 

7.4 

K*N 

XCA 

PAC 

0.1 

SXD 

TST1.1 

SXD 

TST3.1 

SXD 

TST5.1 

SXD 

TST7.1 

AXT 

0.1 

AXT 

1.2 

CLA* 

5 . 4 

NAME 

STO 

CNAME 

NAME  IN  ADDRESS 

CAL* 

7.4 

N 

SLW 

CN 

N  IN  ADDRESS 

ACL 

CNAME 

START  CHECKSUM  OFF  WITH  NAME  AND 

ACL 

CM 

SLW 

TEMP 

LDO 

CN 

MPY 

CM 

STO 

MTN 

NZT 

MTN 

TRA 

PTWT1-1 

ZET 

TESTC1 

IS  Mill)  “  M  =  NULL 

TRA 

NULLCS 

NULL  MATRIX 

CAL 

TEMP 

CSM 1  ACL 

**  .  1 

A 

XCL 

CLA* 

CSM1 

TZE 

GCK.SMB 

STO 

TESTC2 

MATRIX  NOT  NULL 

ANA 

=0377400000000 

TNZ 

*  +  2 

STZ 

TESTC3 

MATRIX  NOT  SPARSE 

GCK.SMB  XCL 

TXI 

*♦1 .1  .** 

-K 

TST 1  TXH 

CSM1 . 1 .** 

-K*N 

SXD 

TEMP. 2 

LDC 

TEMP. 1 

TXI 

*+1.2.1 

TST2  TXL 

CSM 1.2.** 

M 

SLW 

TEMP 

CLA 

TESTC2 

TMI 

PTWT 

TNZ 

PTWT 

00000087 
00000088 
00000089 
00000060 
00000061 
00000062 
00000063 
00000064 
00000065 
00000066 
00000067 
00000068 
00000069 
00000070 
00000071 
00000072 
00000073 
00000074 
00000075 
00000076 
00000077 
00000078 
00000079 
00000080 
00000081 
00000082 
00000083 
00000084 
00000085 
00000086 
DIMENSIONS00000087 
00000088 
00000089 
00000090 
00000091 
00000092 
00000093 
00000094 
00000095 
00000096 
00000097 
00000098 
00000099 
00000100 
00000101 
00000102 
00000103 
00000104 
00000105 
00000106 
00000107 
00000108 
00000109 
00000H0 
00000  111 
00000112 
00000H3 
00000114 
00000115 
000001 16 
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NULLCS 

CAL 

WDMNL 

SLW 

TESTC1 

ACL 

CN 

ACL 

CM 

ACL 

CNAME 

SLW 

TEMP 

STZ 

TESTC3 

TRA 

PTWT1 

PTWT 

NZT 

TESTC3 

TRA 

PTWT  1 

AXT 

0.1 

AXT 

1.2 

AXT 

0.4 

PXA 

0.0 

FIXSP 

ZET* 

C-SM1 

TRA 

CKWC 

TXI 

*+1.4.1 

SXA 

SPIR.l 

TXI 

*+1.1 .** 

TST5 

TXH 

FIXSP. 1.** 

SXD 

TEMP, 2 

LDC 

TEMP.l 

TXI 

*+1.2.1 

TST6 

TXL 

FIXSP, 2.** 

SLW 

TEMP 

PXA 

0,4 

TZE 

*  +  3 

LXA 

SPIR.l 

STO* 

CSM1 

ACL 

TEMP 

ACL 

CN 

ACL 

CNAME 

ACL 

CM 

ACL 

WDSPSE 

SLW 

TEMP 

TRA 

PTWT  1 

CKWC 

ACL* 

CSM1 

TXH 

*+2 ,4,0 

TRA 

TST5-2 

SLW 

TEMP 

SXD 

SPIR.l 

LXA 

SPIR.l 

PXA 

0,4 

STO* 

CSM1 

ACL 

TEMP 

LXD 

SPIR.l 

AXT 

0.4 

TRA 

TST5-2 

STZ 

TESTC3 

PTWT  1 

CALL 

. F V I 0 , ( TAPE. 

CALL 

.FWRB. (TAPIS 

cla 

CNAME 

TSX 

•  FBLT  .  .4 

CLA 

CM 

TSX 

.FBLT. ,4 

CLA 

CN 

TSX 

.FBLT.  .4 

CLA 

TEMP 

TSX 

.FBLT. .4 

CLA 

TESTC3 

NULL  MATRIX 

NULL  MATRIX  CHECK  SUM 

SPARSE  MATRIX 
0  COUNT 

ADD  1  TO  ZERO  COUNT 
ELEMENT  LOC. 

-K 

-K*N 

M 

STORE  0  COUNT 

FORM  SPARSE  CHECK  SUM 


ANY  ZEROES  YET 

LOC.  NON-ZERO  TERM  AFTER 
LAST  ZERO  ELEM.  LOC. 

STORE  CONTROL  WORD 
UPDATE  CHECKSUM 

ZERO  COUNT-O 

TAPIS) 

) 

NAME 

M 

N 

CHECKSUM 


00000117 

00000118 

00000119 

00000120 

00000121 

00000122 

00000123 

00000124 

00000125 

00000126 

00000127 

00000128 

00000129 

00000130 

00000131 

00000132 

00000133 

00000134 

00000135 

00000136 

00000137 

00000138 

00000139 

00000140 

000001*1 

00000142 

00000143 

00000144 

00000145 

00000146 

00000147 

00000148 

00000149 

00000130 

00000131 

00000132 

00000133 

00000134 

00000135 

00000136 

COUNT  00000137 

00000138 
00000139 
00000160 
00000161 
00000162 
00000163 
00000164 
00000165 
00000166 
00000167 
00000168 
00000169 
00000170 
00000171 
00000172 
00000173 
00000174 
00000175 
00000176 
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TSX 

•FBLT •  .4 

SPARSE  OR  0 

00000177 

AXT 

5  *  1 

00000178 

CLA 

=  0 

00000179 

TSX 

.FBLT. *4 

5  CONSECUTIVE  ZEROES 

00000180 

T  IX 

*-2.1 *1 

00000181 

LXA 

XR4.4 

00000182 

AXT 

6.1 

00000183 

CLA 

8.4 

B 

00000164 

ADD 

=  6 

00000185 

STA 

*+l 

00000186 

CLA 

**.l 

ADDRESS  B+6 

00000167 

TSX 

.FBLT •  .4 

6  NUMBERS  OF  B 

00000168 

T  IX 

*-2.1 .1 

00000189 

CALL 

•  FWLR  » 

00000190 

call 

•  FWRB . ( TAP  I B ) 

00000191 

nzt 

MTN 

00000192 

TRA 

CK.WZR 

00000193 

NZT 

TESTC1 

00000194 

TRA 

NWRTE 

MATRIX  NOT  NULL 

00000195 

CLA 

TESTC1 

M»NULL 

00000196 

TSX 

.FBLT.  .4 

00000197 

AXT 

15.1 

00000198 

CLA 

=  0 

00000199 

TSX 

.FBLT  .  .4 

00000200 

T  IX 

*-2.1  .1 

00000201 

TRA 

WLR 

00000202 

NWRTE  AXT 

0.1 

00000203 

AXT 

1.2 

00000204 

NZT 

TESTC3 

00000205 

TRA 

WRTE 

MATRIX  NOT  SPARSE 

00000206 

AXT 

0 . 4 

NUMBER  OF  WORDS  COUNT 

00000207 

SPWRTE  CLA* 

CSM1 

00000208 

TZE 

TST7-1 

00000209 

ANA 

=0377400000000 

00000210 

LDQ* 

CSM1 

00000211 

TNZ 

*  +  2 

NOT  CONTROL  WORD 

00000212 

STZ* 

CSM1 

ZERO  OUT  CONTROL  WORD 

00000213 

XCA 

00000214 

SXD 

TEMP. 4 

00000215 

TSX 

.FBLT  .  .4 

00000216 

LXD 

TEMP .4 

00000217 

TXI 

*+1.4.1 

00000218 

T  X I 

*+1.1 »** 

-K 

00000219 

TST7  TXH 

SPWRTE. 1.** 

-K*N 

00000220 

SXD 

T  EMP . 2 

00000221 

LDC 

TEMP. 1 

00000222 

TXI 

*  +  l  .2.1 

00000223 

TST8  TXL 

SPWRTE. 2.** 

M 

00000224 

PXA 

0.4 

00000225 

SUB 

■16 

00000226 

TPL 

WLR 

MORE  THAN  16  WORDS 

00000227 

SSP 

00000228 

TRA 

WRZR 

00000229 

» 

WRITE  FIXED  POINT  MATRIX 

00000230 

WRTE  CLA* 

CSM 1 

CHECKSUM  CORRECT 

00000231 

TSX 

.FBLT. .4 

00000232 

TXI 

*+1.1 .** 

-K. 

00000233 

TST3  TXH 

WRTE » 1  .** 

-K*N 

00000234 

SXD 

TEMP. 2 

00000235 

LDC 

TEMP . 1 

00000236 
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TXI 

*+1*2*1 

00000237 

TST4 

TXL 

WRTE  *  2  *** 

M 

00000238 

CKWZR 

CLA 

*16 

00000239 

SUB 

MTN 

00000240 

TMI 

WLR 

00000241 

TZE 

WLR 

00000242 

WRZR 

PAX 

Oil 

M*N  LESS  THAN  16 

00000243 

CLA 

=  0 

00000244 

TSX 

.FBLT. .4 

00000245 

T  IX 

*-2  till 

00000246 

WLR 

CALL 

•FWLR • 

00000247 

XR4 

AXT 

**»4 

00000243 

STZ* 

12*4 

00000249 

RETURN 

WRTETP 

00000230 

FILEER 

CLA 

•1 

FILE  SPACING  ERROR 

0000023 1 

LXA 

XR4*4 

00000232 

STO# 

12*4 

00000233 

RETURN 

WRTETP 

00000234 

RCDER1 

CLA 

*2 

NEGATIVE  MATRIX  SPACING 

00000235 

TRA 

F  ILEER+1 

00000236 

RCDER2 

CLA 

-3 

MATRIX  SPACING  ERROR 

00000237 

TRA 

FILEER+1 

00000238 

WDMNL 

BCI 

1 *M*NULL 

0 0000239 

WDSPSE 

BCI 

1 *SPARSE 

00000260 

TESTC1 

PZE 

00000261 

TESTC2 

PZE 

00000262 

TEST  C3 

PZE 

00000263 

SPIR 

PZE 

00000264 

MTN 

PZE 

00000265 

TEMP 

HTR 

0 

00000266 

MFILE 

HTR 

0 

00000267 

MMAT 

HTR 

0 

00000268 

IRR1 

HTR 

0 

00000269 

TAPE 

HTR 

0 

00000270 

CNAME 

PZE 

0 

00000271 

CM 

PZE 

0 

00000272 

CN 

PZE 

0 

00000273 

TAP  1 8 

PZE 

TAPE  FOR  IOCS 

00000274 

END 

00000275 
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SUBROUTINE  FVIO 


$  I BMAP 

FVIO 

50. ( ) OK . DECK 

TTL 

FVIO  -  FORTRAN  VARIABLE  I/O  LOGICAL  UNIT 

3FA000Z0 

REM 

3FA00030 

REM 

CALLING  SEQUENCE  IS 

CALL  .FVIO. (LN. ERAS)  WHERE  LN  IS 

3FA000^0 

REM 

LOCATION  OF  VARIABLE  LOGICAL  UNIT  AND  ERAS  WIlL  CONTAIN  3FA00030 

REM 

CONTENTS  OF  APPROPRIATE  .UNXX.  I.UNXX.  CONTAINS 

3  FA00060 

REM 

PZE  UNITXX  WHERE  XX 

CORRESPONDS  TO  LOGICAL  UNIT  N). 

3FA00070 

REM 

FVIO  IS  CALLED  FOR 

ANY  I/O  STATEMENT  SPECIFYING 

3FA000S0 

REM 

A  VARIABLE  LOGICAL 

UNIT. 

3FA00090 

REM 

3FA00100 

.FVIO. 

SAVE 

(  2  ) 

(D3FA00U0 

CLA* 

3.4 

PICK  UP  LOGICAL  UNIT  NUMBER 

( 1 ) 3FA001^0 

PAC 

.2 

( 1 ) 3FA00130 

TXL 

ERROR.2.-NUNITS-1 

IS  UNIT  ZERO,  OR  TOO  LARGE 

( 1) 3FA00140 

CLA* 

TABLE. 2 

SAVE  ADDRESS  OF 

( 1 ) 3FA001S0 

STO* 

4.4 

FILE  CONTROL  BLOCK 

( 1 ) 3FA00160 

RETURN 

.FVIO. 

(  1  )  3FA00170 

error 

CLA* 

3.4 

LOGICAL  UNIT  IN  ERROR 

(  1  ) 3FA002S0 

ANA 

ADMSK 

DEFINED  FOR  THIS  UNIT  VALUE. 

3FA00260 

XCA 

CONVERT  THIS  ILLEGAL  VAlUE 

3FA00270 

AXT 

0.4 

TO  DECIMAL  FOR  ERROR  MESSAGE. 

3FA002B0 

STZ 

TEMP 

3  F  A  00  2  90 

CNVT 

PXA 

0.0 

3FA00300 

DVP 

L(  10) 

3FA00310 

ALS 

0.4 

3FA00320 

ORS 

TEMP 

3FA00330 

CLA 

=  1 

3FA00340 

TLQ 

*  +  2 

3FA003S0 

TXI 

CNVT. 4. -6 

3FA00360 

CAL 

BLANKS 

3FA00370 

ALS 

6.4 

3FAOO3S0 

ORA 

TEMP 

3FA00390 

SLW 

E47MES+6 

3FA00400 

UNERR 

CALL 

•FXEM. (CODE) 

EXIT  FOR  EXECUTION  ERROR. 

3FA00410 

TRA 

. LXERR 

NO  OPTIONAL  EXIT. 

3FA00420 

CODE 

PZE 

47 

3FA00430 

ER47MS 

PZE 

E47MES. .7 

3FA00440 

ER470P 

PZE 

NOOPXT  »  .7 

3FA004S0 

E47MES 

BCI 

7.0LOGICAL  UNIT  NOT 

DEFINED  FOR  VALUE 

3  F  A00460 

NOOPXT 

BCI 

7.0NO  OPTIONAL  EXIT 

-  EXECUTION  TERMINATED 

3FA00470 

admsk 

OCT 

000000077777 

3FA004S0 

TEMP 

PZE 

** 

3  F  A00490 

L  (  10) 

DEC 

10 

3FA00500 

BLANKS 

BCI 

1  . 

3FA00510 

TABLE 

PZE 

NUNITS 

3FA00530 

PZE 

. UNO  1 . 

3FA00560 

PZE 

•UN02 . 

3FA00570 

PZE 

•UN03 . 

3FA005B0 

PZE 

•UN04 . 

3FA00590 

PZE 

•UN05 . 

3FA00600 

PZE 

. UN06  . 

3FA00610 

PZE 

. UN07  . 

3FA006L0 

PZE 

. UN08  • 

3FA00630 

PZE 

. UN09  . 

PZE 

•UN10. 

PZE 

•  UN  1 1 • 

PZE 

.UN  12 . 
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PZE  .UN13. 

PZE  .UN14, 

PZE  .UN15. 

PZE  .UN16. 

PZE  .UN17. 

*  ADDITIONAL  UNITS  MAY  BE  INSERTED  HERE.  FOR  EACH  UNIT  3FA00640 

*  INSERTED*  A  CORRESPONDING  ROUTINE  MUST  BE  INSERTED  TO  3FA006S0 

*  PRODUCE  A  SFILE  CARD  FOR  THE  ADDITIONAL  UNIT*  3FAOO66O 

NUNITS  EQU  *-T ABLE-1  3FA00670 

END  3FA00660 
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SUBROUTINE  FILE 


SIBNIAP  FILE 

DECK 

ENTRY 

»  UN01 • 

ENTRY 

•  UN02  • 

ENTRY 

• UN03 • 

ENTRY 

• UN04 • 

ENTRY 

. UN07  . 

ENTRY 

« UN08  . 

ENTRY 

•UN09. 

ENTRY 

•UNIO • 

ENTRY 

.UN  11  • 

ENTRY 

«UN12 • 

ENTRY 

•  UNI  3 • 

ENTRY 

• UN14 . 

ENTRY 

•  UN  1 5  • 

ENTRY 

•  UN  16 • 

ENTRY 

.UN17. 

.UNOX. 

PZE 

UN  I  TO  1 

• UN02  » 

PZE 

UNIT02 

• UN03 • 

PZE 

UN  I  TO  3 

• UN04, 

PZE 

UNIT04 

. UN07 . 

PZE 

UNIT07 

. UNO  8  . 

PZE 

UNIT08 

. UN09 . 

PZE 

UN  I  TO  9 

.  UN  1 0 , 

PZE 

UNIT10 

.UNI  1. 

PZE 

UNI  Til 

•  UNI 2  » 

PZE 

UN  I T 12 

•  UNI  3  * 

PZE 

UN I T 1 3 

•UN14. 

PZE 

UN  I T 14 

. UNI  5 . 

PZE 

UNIT15 

*  UN16 • 

PZE 

UN  I T 1 6 

. UNI  7 • 

PZE 

UN  I T 1 7 

UN  I  TO  1 

FILE 

»UT1 .READY, I NOUT.BIN. SCRATCH 

UNIT02 

FILE 

,UT2» READY. I NOUT ,B I N , SCR A TCH 

UN  I  TO  3 

FILE 

»UT3 .READY. I NOUT .BIN, SCRATCH 

UNIT04 

FILE 

»UT4» READY, I NOUT.BIN .SCRATCH 

UN  I  TO  7 

FILE 

♦PP1 .READY .OUTPUT »BLK=14,BCD» PUNCH 

UNIT08 

FILE 

•  C ( 1 )  .READY. I NOUT. BIN, SCRATCH 

UNIT09 

FILE 

,  LB4. READY, I NOUT .MXBCD. SCRATCH 

UNIT10 

FILE 

,  C ( 2 ) .READY. I NOUT. BIN, SCRATCH 

UNIT11 

FILE 

»C ( 3 ) .READY. INOUT.BIN, SCRATCH 

UNIT12 

FILE 

,C(4) .READY. I NOUT .BIN, SCRATCH 

UN  I T 1 3 

FILE 

»C!5) .READY, INOUT.BIN, SCRATCH 

UNIT14 

FILE 

.Bill .READY, INOUT.BIN, SCRATCH 

UN  I T 15 

FILE 

»B  <  2 )  .READY, INOUT.BIN, SCRATCH 

UN  I T 16 

FILE 

.All) .READY, INOUT.BIN, SCRATCH 

UNIT17 

FILE 

END 

, A ( 2 ) .READY, INOUT.BIN, SCRATCH 
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SUBROUTINE  INRPRD 


SIBMAP 

INRPRD 

60  *M94  *  DECK 

00000000 

*  I NRPRD 

SUBROUTINE  TO  COMPUTE  AN  INNER  PRODUCT  (7094/2 

ONLY  >00000001 

00000002 

* 

CALL  INRPRD 

(A* INCRMA. B* INCRMB *PROD.N) 

00000003 

» 

A  =  STARTING 

ADDRESS  OF  ROW 

00000004 

» 

INCRMA  -  STORAGE  INCREMENT  FOR  ELEMENTS  OF  A 

00000005 

* 

B  -  STARTING 

ADDRESS  OF  COLUMN 

00000006 

* 

INCRMB  *  STORAGE  INCREMENT  FOR  ELEMENTS  OF  B 

00000007 

* 

PROD  -  LOCATION  WHERE  PRODUCT  IS  TO  BE  STORED 

00000008 

* 

PRDSUM  ENTRY 

ADDS  THE  RESULT  TO  THE  PROD  CELL 

00000009 

* 

N  -  NUMBER  OF  ELEMENTS  IN  ROW  OR  COLUMN 

00000010 

OOOOOOU 

ENTRY 

PRDSUM 

00000012 

£ 

00000013 

INRPRD 

SAVE 

(  1  »  2  *  4 )  I 

00000014 

CAL 

IN 

FIND  OUT  WHERE  TO  GO 

00000015 

TNZ 

PRDSUM+2 

IF  NON-ZERO*  ENTRY  WAS  AT  PRDSUM 

00000016 

TRA 

BEGIN-2 

00000017 

PRDSUM 

STL 

IN 

SAVE  ENTRY  LOCATION 

00000018 

TRA 

INRPRD 

00000019 

CAL 

ADD 

STUFF  FOR  SUMMING  WITH  RESULT  CELL 

00000020 

SLW 

SUM1 

00000021 

TRA 

BEGIN 

00000022 

CAL 

NOADD 

STUFF  FOR  SIMPLE  INNER  PRODUCT 

00000023 

SLW 

SUM1 

00000024 

BEGIN 

SXA 

XR4»4 

00000025 

CAL 

3*4 

PRE-MULT 

00000026 

STA 

OVER 

00000027 

CAL 

5*4 

POST-MULT 

00000028 

STA 

OVER+1 

00000029 

CLA* 

4*4 

PRE-MULT.  INCREMENT 

00000030 

PAC 

0*2 

NEGATIVE  OF  INCREMENT  FOR  A 

00000031 

SXD 

LOOPND-2»2 

00000032 

CLA* 

6*4 

POST-MULT.  INCREMENT 

00000033 

PAC 

0*2 

NEGATIVE  OF  INCREMENT  FOR  B 

00000034 

SXD 

LOOPND-1.2 

00000035 

AXT 

0*1 

CONTROL  FOR  A 

00000036 

AXT 

0*2 

CONTROL  FOR  B 

00000037 

CLA* 

8*4 

N 

00000038 

PAX 

0*4 

CONTROL  FOR  NUMBER  OF  ELEMENTS 

00000039 

START 

STZ 

TEMPAD 

CLEAR  SUMMING  CELL 

00000040 

STZ 

TEMPAD+1 

00000041 

OVER 

LDQ 

***1 

A 

00000042 

FMP 

**  •  2 

B 

00000043 

DFAD 

TEMPAD 

00000044 

DST 

TEMPAD 

00000045 

TXI 

*+1*1*** 

-INCRMA  IN  DECREMENT 

00000046 

TXI 

*+1*2#** 

-INCRMB  IN  DECREMENT 

00000047 

loopnd 

T  IX 

OVER  *4 • 1 

00000048 

XR4 

AXT 

**  *  4 

00000049 

SUM1 

HTR 

9*4 

THIS  SHOULD  ALWAYS  BE  STUFFED 

00000050 

FRN 

00000051 

STO* 

7*4 

INNER  PRODUCT 

00000052 

STZ 

IN 

00000053 

RETURN 

INRPRD 

00000054 

IN 

PZE 

0 

FLAG  FOR  ENTRY  POINT 

00000055 

TEMP AD 

BSS 

2 

TEMPORARY  STORAGE  FOR  D.P.  SUMMING 

00000056 
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NOADD  TRA  SUM1+1 

ADD  FAD#  7.4 

END 


USED  FOR  INRPRD  ENTRY 
USED  FOR  PRDSUM  ENTRY 


00000057 

00000058 

00000059 
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SUBROUTINE  FRUN 


SIBMAP 

FRUN 

50* LI  ST  »DECK»M94/2 

#  *  * 

*  *  *  * 

***##*##****# 

* 

CALL  UNLOAD  ( LTAPE ) 

* 

LTAPE  -  LOGICAL  TAPE  NUMBER 

#  *  * 

*  #  #•  * 

» 

LDIR 

UNLOAD 

SAVE 

4,1 

CLA* 

3,4  LOGICAL  NUF 

STO 

TEMP 

CALL 

•  FVIO • ( TEMP  » TEMP+1 ) 

LAC 

TEMP+1,4 

SCA 

SETB, 4 

RUN 

TSX 

•CLOSE, 4 

SETB 

PZE 

** 

NOP 

RETURN 

UNLOAD 

LORG 

ERASE 

CONTRL 

ER 

USE 

ER 

TEMP 

BSS 

2 

BSS 

ie 

END 

RUN00010 

RUN00040 

•  *»*•«*#•»«*•*  ruIMOOOSO 

RUN00060 

RUN00070 

RUN00080 

RUN00090 

•*•••*••»«•••*  RUNOOlOO 

RUNOOl  10 
RUN00120 
RUNOOl 30 
RUNOOlOO 
RUN001&0 
RUN00160 
RUN00170 
RUN00190 
RUN00250 
RUN00260 
RUN00270 
RUN00280 
RUN00290 
RUN00300 
RUN00310 
RUN00320 
RUN00330 
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APPENDIX  III 


PHASE  I  PROGRAM  LISTING 
This  appendix  contains  the  following  listings: 

Subroutine  Pa6e 


PHASE  I  MAIN  PROGRAM .  261 

MAST .  265 

PAGHED .  269 

UNPACK .  270 

PRINT . . .  271 

SUBM1 .  272 

GENRAT .  273 

REDUCE .  274 

INFO  .  275 

PLATE .  278 

MUL1  .  284 

MUL2  .  285 

PSTIF  .  286 

QUAD  .  287 

LAMK  .  289 

KLAMT .  290 

TRI .  291 

INP .  293 

INPM .  294 

IN  PST  .  297 

OUTP  .  299 

OUTPM .  300 

OUTPSH .  301 

COM  BIN .  303 

STORE .  304 

MOVE  .  306 

PMTR  .  307 

SMTR  .  309 

LOCAL .  312 

COPLAN .  314 

BEAM  .  315 

TINVR .  323 

SMULT .  325 

MULT  .  326 

SBMTR .  327 

SSTIF  .  329 

MAD .  331 

SBGS .  332 

OFST .  333 

CSTIF  .  334 

CBMTR .  337 

.  MERGE .  340 

SOR  .  341 

MERGBC .  342 
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Subroutine 


Page 


STRESS .  351 

MSTRES  . 1  !  352 

SOLN  .  354 

TEST  .  355 

FKSORT .  356 

KFFSRT  .  359 

CONECT .  363 

EXPAND .  365 

EXTRAN .  367 

DELETE  .  370 

SSORT .  374 

FREMOD .  378 

valvct . .!!!!!!!!!.'!!!  383 

HESSEN  .  384 

QRITER  .  385 

SORTRT  .  387 

vector  . ....!!!!!!!!!  388 

TRANS  1  389 

TRANS  2  390 

AMERGE  .  391 

smerge  . ."!!!!!!!!!!!!!!!!!!  393 

PHASE  I  TLOl  DATA  LISTING . .  ’  ’  .  *  396 


260 


nnnnnnnnnnnnnnnonnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnw 


SUBROUTINE  PHASE  1 


PHASE  I  PROGRAM  LISTING 
PHASE  I -MAIN  PROGRAM 


IBFTC  PHASE ^##^j|jj*#########1HHHHHHt##*********##*####**##**#**** 

*  * 
♦RANDOM  VIBRATION  ANALYSIS  SYSTEM  FOR  COMPLEX  STRUCTURES* 


#  (  R  A  N  V  I  B  )  * 

************************************************** 


PHASE  1 

MAIN  PROGRAM  -  THE  EIGENVALUE  EIGENVECTORS  (FREMOD  ROUTINE)  AND  THE 
STRUCTURAL  ANALYSIS  PROGRAM  (MAST)  IS  CALLED  IN  THIS 
PROGRAM* 


♦♦♦TAPE  USAGE*** 

NTAP10-0UTPUT  TAPE.  THE  FOLLOWING  ITEMS 
ARE  STORED  ON  THIS  TAPE. 
*********** 

*  STIFFNESS  * 

*  FLEXIBILITY  * 

*  *EOF  * 

*  STRESS ( PLATES )  * 

*  * 


*  STRESS ( BEAMS )  * 

*  *EOF  * 

*  FREQUENCIES  * 

*  MODE  SHAPES  * 

*  GENERALIZED  MASS  * 

*  *EOF  * 

*  MASS! CARD  INPUT)  * 

*  *£OF  * 

*  * 


*  * 
*********** 


NTAP2-  MAST  OUTPUT.  THE  FOLLOWING 

ITEMS  ARE  STORED  ON  THIS  TAPE. 


* 

***** 

****** 

* 

# 

parameter 

MATRIX 

* 

# 

•EOF 

* 

* 

STIFFNESS 

MATRIX 

* 

* 

•  EOF 

* 

* 

FLEXIBILITY  MATRIX 

* 

* 

♦  EOF 

* 

*********** 


NT APS-  MAST  OUTPUT.  THE  FOLLOWING 

ITEMS  ARE  STORED  ON  THIS  TAPE. 
************* 

*  PARAMETER  MATRIX  * 

*  *EOF  * 
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*  STRESS ( BEAMS )  * 

*  *EOF  * 

■*  * 

*  ##*#♦******* 


NTAP12-  MAST  OUTPUT.  THE  FOLLOWING 

ITEMS  ARE  STORED  ON  THIS  TAPE. 
************* 

*  PARAMETER  MATRIX  * 

*  *EOF  * 

*  STRESS(PLATES)  * 

*  *EOF  * 

*  * 
************* 


IF  FLG2=0  STRESSES  ARE  NOT  CALCULATED 
«1  STRESSES  FOR  PLATES  ONLY 
-2  STRESSES  FOR  BEAMS  ONLY 
.3  STRESSES  FOR  PLATES  AND  BEAMS 


IF  FLG1-0 

FLG1  NOT  0 


MAST  AND  FREMOD  ROUTINES 
FREMOD  ROUTINE  ONLY 


COMMON/PRNT/NPRNTK.NSTRSP.NSTRSB 

INTEGER  FLG1.FLG2 

NTAP1  «  10 

NTAP2  «  2 

NTAP8  -  8 

NTAP 12  =  12 

REWIND  NTAP1 

REWIND  NTAP 2 

REWIND  NTAP8 

REWIND  NTAP 12 

**•  READ  IN  THE  CONTROL  CARD 

READ ( 5.9000 )  FLG1 *FLG2  * NPRNTK .NSTRSP .NSTRSB 

***  IF  FLG1  IS  NOT  EQUAL  TO  0*  THEN  ONLY  THE  EIGENVALUE-EIGENVECTOR 
ROUTINE  IS  CALLED.  OTHERWISE.  THE  MAST  ROUTINE  IS  ALSO  CALLED. 
I F  t  FLG1  .NE.  0  )  GO  TO  50 


***  THE  MAST  PROGRAM  CALCULATES  THE  STIFFNESS.  FLEXIBILITY  AND 
STRESS  MATRICES. 

***************** ************************************** *********** 


CALL  MAST 


REWIND  NT API 

***  MERGE  THE  STIFFNESS  MATRIX 

NFILE  =  1 

****************************************************************** 
CALL  AMERGEt  NTAP2.  NTAP 1 .  NFILE  ) 


MERGE  THE  FLEX  MATRIX 
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♦♦I*********************************  #*■*■**#»##*»********  *********** 

CALL  AMERGE  <  N  T  A  P  2  #  NTAP1»  NFILE  ) 

END  FILE  NT AP 1 

IF  (  FLG2  »EQ.  0  )  GO  TO  45 
GO  TO  110*20*10) »  FLG2 

*«•  MERGE  THE  STRESS  MARICES  FOR  PLATES  AND  REPARTITION  TO  8XN 
10  I  TYPE  =  8 

****** *************************** *********************** *********** 
CALL  SMERGEI  NT AP8 » NTAP 1 • I T YPE  ) 

I F (  FLG2  .EQ.  3  )  GO  TO  20 
GO  TO  45 

**•  MERGE  THE  STRESS  MATRICES  FOR  BEAMS  AND  REPARTITION  TO  6XN 
20  I  TYPE  =  6 

****************************************************************** 
CALL  SMERGEI  NTAP12 »NTAP1 • I  TYPE  ) 

***FREMOD  PROGRAM  IS  CALLED  TO  FIND  THE  E I  GEN VALUES  I FREQUENC I ES ) * 

EIGENVECTORS! MODE  SHAPES)  AND  GENERALIZED  MASSES. 


45  END  FILE  NT  API 

^  a***************************************************************** 

50  CALL  FREMOD 
C 

9000  FORMAT (5  1 10) 

RETURN 

END 


SIBFTC  BLK  DECK 
BLOCK  DATA 

COMMON / T APES/ MT l*MT2*MT3»MT4*MT5«MT6»MT7tMT8*MT9»MT10*MTll*MT12t 
*  MT13*MT14*MT15tMT16*MT17 

DATA  MT1*MT2*MT3#MT4»MT5*MT6#MT7*MT8#MT9*MT10»MT11»MT12*MT13*MT14» 
«  MT15*MT16»MTX7/l*2»3*4»5t6»7*8»9»10»ll*12»13*14*15*16»17/ 
COMMON/REDUC/NTEST  *NTEST2 
DATA  NTEST/6HAND  ST / ♦ NT EST2/6HONLY  / 

END 
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SUBROUTINE  MAST 


SlBFTC  MAST*  DECK 

SUBROUTINE  MAST 


PROGRAM  CONTROL  PARAMETERS 
0  NO  EXECUTION 

1  EXECUTION 

2  PRINT 

NP=0  {60*60  PARTITIONS) 

IF  NVIB  EQUALS  1  PARTITIONS  ARE  PRINTED 

COMMON /RENT /NR ENT  *KRENT 
COMMON/M APSTR/ IPTOT  * 1BTOT 
COMMON /CONT 1/JPART(800) 

COMMON/LASTND/LN ( 200 ) 

COMMON/COMS/NS I ZE  <  200 ) 

COMMON/ TERMS/NBEAM»NPLATE*NNODE*NCOND*NPS#NTOL*NP ,NOPT (4) 
COMMON/CONTRL/NDEFL*NKSP»NREX#NNF*NPSTR*NBSTR*NVIB*lF88 
COMMON /T  APE S/M T 1*MT2*MT3#MT4*MT5*MT6»MT7*MT8»MT9»MT10*MT11*MT12* 
*  MT13*MT14*MT15*MT16*MT17 
COMMON/ T  ITL/TITLEI13) 

COMMON/ PAGE/NP AGE 
COMMON/REDUC/NT EST  #NTEST2 
DIMENSION  I  ERROR! 5) 

INTEGER  FRPR  *SRP  *SRB*FR 

SET  ALL  OPTIONS  JO  ZERO 
NDEFL  *  0 
NKSP  -  0 
NREX  =  0 
NNF  =  0 
NBSTR  ■  1 
NPSTR  *  1 
I F80  =  0 
NCOND  »  0 
1  NPS=0 
NTOL=0 
NPAGE=0 
DO  5  1-1*5 
I  ERROR (I)  -  0 
5  CONTINUE 
REWIND  MT2 
REWIND  MT4 
REWIND  MT8 
REWIND  MT11 
REWIND  MT12 
REWIND  MT1 
REWIND  MT3 
REWIND  MT16 
IN  «  MT 5 
I  OUT  »  MT6 
C 

READ! IN*9000)TITLE 

READ  ( IN  *9101 )  NOPT  *NVIB»KRPR*FRPR»SRP»SRB»FR 


041 

043 

067 

068 

069 

070 

071 

072 

073 

074 

075 

076 

077 

078 

079 

081 


085 


086 

087 


101 

104 
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CALL  PAGHED 

WRITE  ( I  OUT  *  9001 )  NOPT 
REAO ( I N »  9 100 ) NBEAM *NPLATE  *NNODE  »NP 
WRITE ( I OUT  *9002 ) NBEAM *NP LATE  *NNODE *NP 
IF  ( NOPT ( 3 )  «EQ*  NTEST)  GO  TO  10 
IF  t NOPT { 3 )  *EQ»  NTEST2  )  GO  TO  10 
GO  TO  99 
C 

10  CONTINUE 
CALL  SUBM1 
C 

CALL  SOLN 


107 

108 
109 
HI 


*****  THIS  SECTION  CONTROLS  THE  EXECUTION  OF  THE  TLOl  DATA  PHASES. 


REWIND  MT9 
AREA  =  1.0 

C  SPACE  TAPE  PAST  FIRST  FILE  CONTAINING  FORTRAN  GENERATION  ROUTINES 
1=1 

50  CONTINUE 

CALL  FSF ( 1 *MT9  *  I ER ) 

I F ( I ER  .NE.  0)  GO  TO  900 

C  EXECUTE  A. TLOl  PHASE  (WHEN  1=1*  <R  WILL  BE  COMPUTED) 

CALL  TLOl(MT9*0t I  ERROR ) 

DO  55  l CELL" 1  *  5 

I F ( I  ERROR ( ICELL )  .NE.  0)  GO  TO  999 
55  CONTINUE 

C  TRANSFER  TO  APPROPRIATE  TEST  TO  DETERMINE  NEXT  TLOl  PHASE  TO  BE  EXECUTED. 
GO  TO  (  100*200*300*400*500*600*700*800) *  I 
100  CONTINUE 

C  IS  PRINTING  OF  KR  DESIRED 

I F  ( K.RPR  .EQ.  0)  GO  TO  150 

C  PRINT  KR 
I  =  2 
GO  TO  50 

C  NO  PRINT  OF  KR 
150  CONTINUE 
AREA  =  2.0 
CALL  FSF ( 1 *MT9  *  I ER ) 

I F ( I ER  .NE.  0)  GO  TO  900 

C  IS  FR  DESIRED 
200  CONTINUE 

I F ( FR  .NE.  0)  GO  TO  250 
I  =  3 
GO  TO  50 

C  NO  FR  DESIRED 
250  CONTINUE 
AREA  =  3.0 
CALL  FSF ( 2  *MT9  *  I ER  ) 

I F { I ER  .NE.  0)  GO  TO  900 
GO  TO  400 
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C  IS  PRINT  OF  FR  DESIRED 
300  CONTINUE 

IFtFRPR  .EQ.  0)  GO  TO  350 

1*4 

GO  TO  50 

C  NO  PRINT  OF  FR  DESIRED 
350  CONTINUE 
AREA  =  4.0 
CALL  FSFd.MT9.IER) 

I F ( I ER  .NE.  0)  GO  TO  900 

C  ARE  STRESSES  DESIRED 
400  CONTINUE 

I F ( NOPT ( 3 )  .NE.  NTEST )  GO  TO  800 
I F ( NPLATE  .EQ*  0)  GO  TO  450 
I  »  5 
GO  TO  50 

C  NO  PLATES 
450  CONTINUE 
AREA  =  5.0 
CALL  FSFI2.MT9.IER) 

I F ( I ER  .NE*  0)  GO  TO  900 
GO  TO  600 

C  IS  PRINT  OF  PLATE  STRESS  DESIRED 
500  CONTINUE 

IFISRP  .EQ.  0)  GO  TO  550 
I  *  6 
GO  TO  50 

C  NO  PRINT  OF  PLATE  STRESSES 
550  CONTINUE 
AREA  =  6.0 
CALL  FSFd.MT9.IER) 

IFIIER  .NE.  0)  GO  TO  900 

C  ANY  BEAMS 
600  CONTINUE 

IFtNBEAM  .EQ.  0)  GO  TO  800 
I  *  7 
GO  TO  50 

C  IS  PRINT  OF  BEAM  STRESSES  DESIRED 
700  CONTINUE 

I F ( SRB  .EQ.  0)  GO  TO  800 
I  =  8 
GO  TO  50 
800  CONTINUE 
REWIND  MT9 
RETURN 

C  ERROR  COMMENT 
900  CONTINUE 

WRITE! IOUT.9902)  IER.MT9.AREA 
STOP 

99  CONTINUE 

WRITE  ( IOUT .9900 )  NOPT 
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STOP 

999  CONTINUE 

WRITE  (IOUT.9901)  I  ERROR 
STOP 

9900  FORMAT ( //49H  ILLEGAL  OPTION  CONTROL  CARD.  CARD  READ  WAS. • • » . • *4A6  * 
*/104H  IT  SHOULD  HAVE  BEEN  ONE  OF  THE  FOLLOW  I NG....» DEFLECT  IONS  ONL 

*  . . ...OR. .......DEFLECTIONS  AND  STRESSES) 

9901  FORMAT  (//54H  TL01  ERROR  WHILE  TRYING  TO  EXECUTE  THE  FOLLOWING  CAR 
*D/5(5X#I10) ) 

9902  FORMAT ( //31H  FSF  ERROR  IN  MAIN.  THE  CODE  -  I5.5X.7HTAPE  -  15. 5X, 

*  7HAREA  =  F2.0) 

C 

9000  FORMAT (13A6) 

9001  FORMAT ( / / 1 1H  CALCULATE  »4A6) 

9002  FORMAT ( //15H  STRUCTURE  SIZE  7X » 5HBEAMS  5X.6HPLATES  4X. 

1  5HNODES  3X.10HPARTITIONS/16X.4I 10) 

9100  F0RMATI3I4.4X.I4) 

9101  FORMAT ( 4A6 . 3X .I1.2X*I1»2X»I1»2X.I1*2X.I1#2X*I1) 


SUBROUTINE  PAGHED 


SIBFTC  PAGH*  DECK 

SUBROUTINE  PAGHED 
COMMON  /TITL/TITLEI 13) 

COMMON /TAPES/MTl .MT2.MT3.MT4.MT5.MT6 .MT7.MT8.MT9.MT10.MT 11 *MT12. 
*  MT13.MT14.MT15.MT16.MT17 
COMMON/PAGE/NPAGE 
I OUT  =  MT6 
NPAGE-NPAGE+1 

WRITE  t IOUT« 100) TITLE iNPAGE 
100  FORMAT ( 1H1.23X.13A6.5X. 5HPAGE  .16) 

RETURN 

END 
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SUBROUTINE  UNPACK 


SIBFTC  UNPAC*  DECK 

SUBROUTINE  UNPACK(IJKLMN*I*J|K,L.M,N)  120 

1^1 

ROUTINE  UNPACKS  BOUNDARY  CONDITIONS  \iz 

lO 

I  =*1  JKLMN/100C00  124 

JP=I JKLMN-100000*I  125 

J=JP/10000  126 

KP=JP“10000*J  127 

K=KP/1000  128 

LP=KP-1000*K  X29 

L  =LP / 100  1 30 

MP-LP-100*U  131 

M=MP/10  132 

N=MP-10*M  1J3 

c  134 

RETURN  135 

END  136 
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r>  r>  r»  r»  o  n 


SUBROUTINE  PRINT 


$  I BFTC  PRINT*  DECK 

SUBROUTINE  PRINT  ( A #NROW #NCOL • CASE . T I TLE .P AGE *N 1 2 )  171 

172 

173 

PRINTS  ONE  OR  TWO  DIMENSIONAL  ARRAYS  174 

LIST  OF  ARGUMENTS  FOR  PRINT  ROUTINE  175 

NROWI I  5 ) .NCOL!  15  )  .CASE! 1 6 ) » T I TLE ( A6 > .PAGE! A1 )  176 

177 

DIMENSION  A ( N I Z • 1 ) »  FMT  (4)  178 

INTEGER  FMT  *H8  179 

DATA  IOUT/6/.NPRNT/8/.H8/1H8/  1«0 

DATA  FMT  t 1 ) / 24H ( 1 X2  I  3  . 1  P  E14.5)/  1»1 

C  182 

IFINR0W.LE.24I  WR I T E ( I  OUT . 9 1 01 ) P AGE  183 

N2=0  184 

IFINCOL.LT. NPRNT)  GO  TO  160  185 

M= 1  186 

95  FMT  t  3 ! *H8  187 

100  N1»N2+1  188 

N2=N2+NPRNT  189 

I F ( NROW . GT • 24 )  GO  TO  120  190 

I F 1 M* ( NROW+6  1.LT.60)  GO  TO  130  191 

120  M=1  192 

WRITE! I OUT  #9102 )  193 

130  I F ( N2  « GT  »NCOL )  GO  TO  170  194 

150  WRITE! I0UT.9103ITITLE. CASE. NROW. NCOL. N1.N2  195 

WRITE! IOUT.FMTJ (I.N1.(A«I.J).J-N1.N2) . I-l.NROW)  196 

M=M+1  197 

I F ( N2 . NE * NCOL )  GO  TO  100  198 

C  199 

RETURN  200 

C  201 

160  Nl«l  202 

170  N2“NC0L  203 

FMT! 3) -N2-N1+1  204 

GO  TO  150  205 

C  206 

9101  FORMAT (All  207 

9102  FORMAT ( 1H1 )  208 

9103  FORMAT (//1X.7HMATRIX  A6.10H  IDENT  NO. 16. 15. 6H  ROWS  209 

1  I5.6H  COLS  3X.7H1ST  COL . 14 . 3X . 8HLAST  COL. 14//)  2l0 

C  211 

END  212 
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r>  r»  r»  n  r> 


SUBROUTINE  SUBM1 


SIBFTC  SUBM1*  DECK 

SUBROUTINE  SUBM1  140 

1^1 

ROUTINE  CALLS  FOR  GENERATION  AND  MERGER  142 

I NER  =  1  IF  A  QUADRILATERAL  PLATE  FAILS  143 

COPLANARITY  TEST  (SEE  COPLAN  SUBROUTINE)  14* 

1  AS 

COMMON /C ON T 1/JPARTI600)  1A6 

COMMON /CONT  2/KPARTI800)  147 

COMMON / CON T  3/LPARTI800)  148 

COMMON /RENT /NR ENT  *KRENT  149 

COMMON/LASTND/LN  (  200  )  ISO 

COMMON/COMS/NSI2E(200)  1S1 

COMMON/ TERMS/NBE AM. NPLATE.NNODE.NCOND.NPS.NTOL.NP  1S2 

COMMON/CONTRL/NDEFL.NKSP»NREX»NNF.NPSTR.NBSTR»NVIB  1  S3 

COMMON /SK I P/NBSP.NBSB.NBSPI . NBSB I  1S>4 

COMMON/NOMERG/ I NER  1&5 

C  1S9 

I NER=0  loO 

NRENT  =  0  161 

CALL  GENRAT  162 

C  163 

IF(NRENT.NE.O)GO  TO  1000  164 

1 F ( I NER • EQ« 1 ) GO  TO  1000  165 

CALL  MERGE  166 

C  167 

1000  RETURN  168 

END  169 
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SUBROUTINE  GENRAT 


SIBFTC  GENRA*  DECK 

SUBROUTINE  GENRAT 

CONTROL  FOR  GENERATION  OF  ELEMENT  MATRICES 

COMMON/CONTI /JPART I  800 ) 

COMMON/CONT  2/KPARTI800) 

COMMON /CONT 3/ L PART ( 800 ) 

COMMON/ L AST ND/LN ( 200 ) 

COMMON/CORD/XN ( 2000 ) * YN ( 2000 ) *ZN ( 2000 > 

COMMON/CONT RL/NDEFL  tNKSP*NREX*NNF tNPSTR » NBSTR » NV I B 
COMMON/ TERMS/NBE AM »NPL ATE  »NNODE »NCOND »NPS *NTOL  *NP 
COMMON /ADPRO/ EM »G»RC  *ALFA*DARC»DL 
COMMON/SSTR/EMM*GG 
COMMON/CHECK/ACPT  *GROSS 

COMMON /T APES/MT1 *MT2*MT3»MT4»MT5#MT6iMT7»MT8*MT9»MT10*MTll*MT12* 
*  MT13»MT14*MT15 »MT16.MT17 
COMMON/FLAG/NFLAG 
COMMON /T ITL/TITLE113) 

C 

IN  =  MT5 
IOUT  =  MT6 
C 

NFLAG=*0 
CALL  INFO 
C 

c 

IFINPLATE.EQ.OIGO  TO  100 

ACPT  =  0*1 

GROSS=1.0 

READ ( I N  •  9000 )  EMM  #GG 
CALL  PAGHED 
CALL  PLATE 
100  CONTINUE 
C 

IF(NBEAM.EQ.O)GO  TO  200 
READ! IN*9000)EMM»GG 
CALL  PAGHED 
CALL  BEAM 
200  CONTINUE 
C 

I F ( NFLA6»NE • 0 ) STOP 
C 

9000  FORMAT (6E12*4) 

RETURN 

END 


215 

216 

217 

218 
219 
2/0 
2/1 
2/2 
2/3 
224 
2/5 
226 
227 
2/8 


232 

233 


241 

242 

243 

244 

245 

246 


248 

249 

250 

251 

252 

253 

254 

255 

263 

264 

265 

266 
267 
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SUBROUTINE  REDUCE 


SIBFTC  REDUC*  DECK 

SUBROUTINE  REDUCE ( A . N *K ) 

C 

DIMENSION  A(NiN) 

C 

DO  100  I  =  1  *N 
DO  100  J“1  «N 

I  F  ( ( I • EQ  »K ) «OR • ( J • EQ  »K ) ) GO  TO  100 
A(  I.J)»A( I#J)-A(K*J)»A( I*K)/A(K»K) 
100  CONTINUE 
C 

DO  500  L«1*N 
A ( L  »  K ) a0  •  0 
500  A(K»L)“0.0 
C 

RETURN 

END 


2  73 
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276 

277 

278 

279 
2B0 
2  B  1 

305 

306 

307 

308 

309 

310 
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nnnnnnn 


SUBROUTINE  INFO 


$  I BFTC  INFO*  DECK 

SUBROUTINE  INFO 

ROUTINE  READS  IN  BOUNDARY  CONDITIONS 
AND  WRITES  BOUNDARY  DATA  ON  TWO  TAPES 
TAPE  I KDF  CONTAINS  SPECIFIED  DEFLECTIONS 
TAPE  I KBC  CONTAINS  NODAL*8.C.  AND  SPRING  DATA 
N18  =  TAPE  CONTAINING  REDUCTION  INFORMATION 

COMMON/CONT 1/JPART ( 800  > 

COMMON /CONT 2 /KP ART ( 800 ) 

COMMON/CONT3/LPART  <  800 ) 

COMMON /LASTND/LN ( 200 ) 

COMMON/CORD/XN ( 2000 ) .YN( 2000) *ZN< 2000) 

COMMON/ CONTRL/ NDEFL  .NKSP »  NR EX . NNF *NPSTR*NBSTR*NVIB 
COMMON/ T ERMS/NBEAM * NPL ATE.NNODE .NCOND »NUM1 » I UM2  *NP 

COMMON /T APES /MT 1 *MT2*MT3*MT4*MT5*MT6*MT7.MT8»MT9*MT10»MT11»MT12^» 
*  MT13.MT14.MT15.MT16.MT17 
COMMON /T ITL/TITLEI13) 

COMMON/REDUC/NTEST 
DIMENSION  FKK( 6 ) *  JKK ( 6 ) 

DIMENSION  KF IX ( 6 ) 

DIMENSIONMAPDI200) 

DIMENSION  I  RET  AN  <  6 ) 

EQUIVALENCEIMAPD.JP ART) 


314 

315 

316 

317 

318 

319 

320 

321 

322 

323 

324 

325 

326 


331 

333 


IN  ■=  MT5 
I  OUT  =  MT6 
I KDF  *  MT4 
I KBC  =  MT3 
N 18  =  MT 1 
DO  30  1-1.200 
30  LN ( I ) =0 
C 

DO  40  I >1 .800 
JPARTI I )-0 
KPART ( I ) “0 
40  LPART ( 1 ) “O 
C 


334 

335 

336 

337 

338 

339 
34Q 
341 
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£•»*••*  SET  UP  PARTITIONS 
I  F ! NP  #  NE . 0 ) GO  TO  100 
C 

NP=NNODE/10 
DO  20  I = 1 iNP 
20  LN( I ) =10*1 

IF< (NNODE-NP*10) .EQ.OIGO  TO  99 
NP=NP+1 
LN ( NP ) -NNODE 
99  CONTINUE 
NUM1-NP 
GO  TO  101 

100  NUM1 =NP 

READ ( IN* 9080) ( LN ( I ) *  I -1 *NP ) 

101  CONTINUE 
C 

WRITE! I  OUT* 9000 ) ( I  * LN ( I) *  I - 1 *NP ) 

CALL  PAGHED 
LINE-0 

WRITE! I  OUT  *  900 1 ) 

C 

C******  LOOP  FOR  EACH  NODE 
DO  500  I  - 1  * NNODE 

C******  DETERMINE  WHICH  PARTITION  THIS  NODE  IS  IN 
DO  250  K= 1  *  NP 

210  IF! I.GT.LN(K) )GO  TO  250 
N I  =K 

GO  TO  251 

250  CONTINUE 

251  CONTINUE 

C******  READ  IN  NODAL  DATA 

45  READ!  IN*9021  )  M  *  JKK.  *XN  <  M  )  *  YN  <  M  )  *ZN  <  M  )  *  <  I  RETAN  <  1 0  )  *  10- 1  *6  ) 

DC  47  10=1*6 

47  l RET  AN ( 10)  =  I  A BS < I  RET AN ! 10  )  ) 

WRITE(NIS)  M 

WRITEIN18)  ( IRETAN! 10) *10-1*6) 

46  CONTINUE 

IF! I *NE#M)WRITE( I  OUT  *9070)M 
DO  51  K  =  1  *  6 

51  JKK (K )  =  I ABS( JKK ( K  )  ) 

I  JKLMN-100000*JKK(1)  +  10000*JKM2)  +  1000*JKK(3)  +  100*JICM4)+10*JKK(5) 

1+ JKK ( 6 ) 

WRITE! I KBC ) M  » I JKLMN 
IF(LINE»LT, 50)60  TO  1 
L I NE  =  0 
CALL  PAGHED 
WRITE! IOUT.9001 ) 

1  CONTINUE 
LINE-LINE+1 

60  WRITE! I OUT  *9012 )  M • JKK  • XN ! M ) * YN ( M ) * ZN ( M ) . < I  RE T AN < 10 ) *  10- 1 *6  > 

C 

65  <  =  0 

DO  300  N= 1 ♦ 6 
300  IF!  JKK.(N).EQ.3)K  =  1 
IFtK.tNE.UGO  TO  350 
READ!  IN*9030)  (FKMJJ)  *JJ=1*6) 

WRITE! IKBC) (FKK(JJ) *JJ-1*6) 

C* *****  READ  SPRING  DATA 


INFO 

342 

343 

344 

345 

346 

347 

348 

349 

350 

351 

352 

353 

354 

355 

356 


361 

362 

363 

364 

365 

366 

367 

368 

369 


371 


372 

373 

374 


375 

376 

377 

378 

379 

380 

381 
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r>  n  rt  <->  r> 


WRITE! I  OUT • 9003 ) < FKK! JJ ) * JJ*1 *6 ) 

LINE=LINE+1 

I  F ( L I NE*  LT  *  50 ) GO  TO  2 

CALL  PAGHED 

LINE=0 

WRITE! 2  OUT  *9001 ) 

2  CONTINUE 


350  CONTINUE  382 

383 

*****  COUNT  FIXED  DEGREES  OF  FREEDOM 

K.-0  385 

DO  102  N«l*6  386 

IF!  (  JKK(N)  .EQ.O  )  .OR»<  JK.MN)  .EQ.3)  )GO  TO  102  387 

K«K+1  388 

KF I X ( K ) *N  389 

102  CONTINUE  392 

417 

500  CONTINUE  418 


419 

420 

9000  FORMAT ( //25H  LAST  NODES  IN  PART  I T IONS/ ( IX  *  10 ! I  3 # 1H *  14 ,5X ))) 

9001  FORMAT < / /41 X » 1 OHNODAL  DATA//6X »4HN0DE * 9X t 2HBC » 14X » 1HX * 18X . 1HY * 18X * 

1  1H2.7X»17HRETAINED  FREEDOMS//) 

9002  FORMAT (6X#I4»7X«6Il»6X*lPE12r4*7XtlPE12»4»7X*lPE12«4) 

9003  FORMAT ( 9H  SPRINGS  6E12.4) 

9012  F0RMAT(6X#I4>7X»6I1»6X*1PE12.4,7X#1PE12.4,7X#1PE12.4,7X,6I1) 


9020  FORMAT! I4#6X»6I1»8X*3E12*4) 

902)  FORMAT! I4t6X,6I 1 » 8X * 3E 12 . 4 »4X *  6 1 1 ) 

9030  FORMAT (6E12. 4)  422 

9040  FORMAT! 14) 

9050  FORMAT (6£12»4) 

9070  FORMAT ! &H  NODE  *I4*16H  OUT  OF  SEQUENCE  )  424 

9080  FORMAT! 1814)  425 

REWIND  N18 

RETURN  426 

END  427 


SUBROUTINE  PLATE 


SI5FTC  PLATE*  DECK 

SUBROUTINE  PLATE  431 

C  432 

COMMON /R ENT /NR ENT  iKRENT  433 

COMMON /CGNT 1 / JPART l 300 )  434 

COMMON/ CO NT  3/LPART l 800 )  435 

COMMON / LA S T N D / L N t  200  )  436 

COMMON /TAPES/MTl  *MT 2  *  MT 3  * MT4  . MTS  » T 6  » M T 7  * M T 8  » M T 9  » M T 1 0  » M T 1 1 » M T 1 2  » 

*  M T 1 3  *  M T 1 4 ♦ M T 1 5  * M T16»MT17 

COMMON / CORD / XN ( 2000 ) » YN < 2  00 5  )  t ZN ( 2000 )  440 

COMMON / T ERMS/NB E AM * NPLAT E • NNODE  * NCON D  *  I P T * NPS  » I UM2  44 1 

C  442 

COMMON/ AD PRO / EM *G*RC*ALFA*DARC»DL  443 

COMMON / SSTR / EMM • GG  444 

COMMON / P  ST  I F  2/H  *  TS  4*5 

COMMON/PST IF1/SK( 16*18 )  446 

COMMON /P ST IF8/SKQ130*30)  447 

COMMON/PST IF9/NP*N5  448 

COMMON /P  ST  I FC/T I BX  *  T I  BY  ♦  T I BS  449 

COMMON /P ST IFD/TX»TY  *TC  4b0 

COMMON /P  ST  I FG/XS 1  *  YS 1  *  ZS 1 *  XS2 * YS  2 * Z  32 * XS3  » YS3  *  ZS3  *  XS4 • YS4 » ZS4  43  1 

COMMON / P  M  T  R 1 / P  T (3*3) 

COMMON/STRAN/GT ( 8 *24)  433 

COMMON/FLAG/NFLAG  434 

COMMON /P  ST IFL/ISWAP  435 

COMMON/SWAP/KSWAP  456 

COMMON/PST I  FH/XL 1 *YLi *XL2  *YL2  *XL3  *YL3  *XL4*YL4  43 7 

COMMON/T ITL/TITLE(i3) 

COMMON/BUCK/IBUC 

COMMON /THRST /TRS1 *TRS2  *  TRS3  *TRS4 • TRS5 i TRS6  »TRS7 
COMMON /P ST  RSS/SKGSS (30  *30) 

C  45? 

DIMENSION  N N ( 1 0 )  *F(24*24)*PI(6*40) 

EQUIVALENCE (F*SK) 

C  463 

C  464 

C  i\4  —  NODc.  NUMSER  FOR  NODE  4  ON  QUADRILATERAL  PLATE  466 

C  10  -  OUTPUT  PARAMETER  (1  PRINT!  467 

C  TIBX  -  MOMENT  OF  INERTIA  FOR  OUT  OF  PLANE  STIFFNESS  IN  X-DIRECTION  468 

C  NP  -  PLATE  NUMBER  465 

C  T I  BY  -  MOMENT  OF  INERTIA  FOR  OUT  OF  PLANE  STIFFNESS  IN  Y-D I RECT I  ON  469 

C  TX  -  THICKNESS  FOR  IN-PLANE  LOADING  IN  X-CIRECTION  47l 

C  TIdS  -  MOMENT  OF  INERTIA  FOR  OUT  OF  PLANE  STIFFNESS  IN  SKIN  DIRECTION  47c 

C  TY  -  THICKinESS  FOR  IN-PLANE  LOADING  IN  Y-D  I  RECT  I  ON  ^72 

C  TO  -  THICKNESS  FOR  IN— PLANE  SHEAR  473 

C  TS  -  THICKNESS  FOR  SKIN  474 

C  E  -  YOUNGS  MODULUS  475 

C  GAMMA  -  PO I SSON  *  S  RATIO  476 

C  SK66  -  STIFFNESS  MATRIX  FOR  (INPST)  AND  (OUTPM)  477 

C  SK99  -  STIFFNESS  MATRIX  FOR  (INP)  AND  (CUTP)  478 

C  XS1 *YSl*ZSl  -  STRUCTURAL  COORDINATE  AT  NODE  1  TRIANULAR  OR  QUADRILATER  479 

C  XS2  *  YS2 • ZS2  -  STRUCTURAL  COORDINATE  AT  NODE  2  TRIANULAR  OR  QUADRILATER  4bQ 

C  XS3  *YS3*ZS3  -  STRUCTURAL  COORDINATE  AT  NODE  3  TRIANULAR  OR  QUADRILATER  481 

C  XS4  ♦  YS4  *  ZS4  -  STRUCTURAL  COORDINATE  AT  NODE  4  QUADRILATERAL  PLATE  482 

C  XL  1  * YL 1  -  LOCAL  COORDINATES  AT  NODE  1  TRIANGULAR  OR  QUADRILATERAL  PLA  483 

C  XL2  * YL2  -  LOCAL  COORDINATES  AT  NODE  2  TRIANGULAR  OR  QUADRILATERAL  PLA  484 

C  XL3  * YL3  -  LOCAL  COORDINATES  AT  NODE  3  TRIANGULAR  OR  QUADRILATERAL  PLA  485 

C  XL4.YL4  -  LOCAL  COORDINATES  AT  NODE  4  QUADRILATERAL  PLATE  486 

C  487 

C  4  38 

C  178  489 


n  r» 


C  490 

I  CON ( I  * J )=1000*MAX0 !  I  * J ) +MI NO l  I i J )  491 

IN  =  MT5 
I  OUT  =  MT6 
KSOLN  =  MT  8 
ISTRS  =  MT 16 

K 1 *  1  492 

ICC=0  493 

L  I  NE  =  0 

WRITE ( I  OUT *9000 )(II*II=1*4) 

1000  NT=0  494 

1001  NT=NT+1  495 

C  READ  PLATE  DATA  496 

READ ( IN*9500)NP*N1*N2*N3*N4*IIN*  10*  IBUC*T.EM*G 
I F  < IBUC.NE.OJREAD!  IN.95021TRS1 .TRS2  * TRS3 * TRS4 * TRS5 * TRS6 * TRS7 
I F( EM) 1060  *  1070  *  1080  499 

1060  WRITE! IOUT*9560)NP  500 

EM= ABS ( EM )  501 

GO  TO  1080  502 

1070  EM=EMM  503 

1080  IF(G) 1090*1100*1110  504 

1090  WRITE!  I0UT*9570)NP  505 

G  =  ABS 1 G  )  506 

GO  TO  1110  507 

1100  G=GG  508 

1110  IF!NP-NT)1120*1125*112Q  509 

1120  WRITE! IOUT»9560)NP*NT  510 

CALL  EXIT  5H 

C  512 

1125  CONTINUE  513 

KSWAP=0  514 

IF! I  IN  — 1)1050*2.3  515 

2  TO=T  516 

TS=T  517 

T  IBS  =  T**3/12.  518 

TX=0»  519 

TY  =  0*  520 

T  I  BX  =  0  •  521 

TIBY=Q.  5  c-l 

GO  TO  1035  5<-3 

3  READ! IN.9501)TX.TIBX.TY.TIBY.TS*TIBS  524 

TO=T  525 

IFITS.EQ.O.)  TS=TO  526 

IFITIBS.EQ.O. )  TIBS=TO*#3/12.  527 

IF! I IN.EQ.2 )  GO  TO  4  526 

T  =  l.-G#*2  5<l9 

TX=-TO*< l.-TX)#T  520 

TY=-TO*( l.-TY)*T  521 

TIBX«-TO*( l.-TISX)*T  522 

TI8Y=-T0*(1.-TIBY)*T  533 

GO  TO  1035  534 

4  CONTINUE  535 

CHECK  VALIDITY  OF  PLATE  INPUT  536 

POSITIVE  MOMENTS  OF  INERTIA  AND  THICKNESSES  537 

IF(NNODE“N 1)1020*1005*1005  538 

1005  IF(NNODE“N 2)1020*1010*1010  539 

1010  IFINN0DE-N3) 1020* 1015  *1015  540 

1015  IF(NN0DE-N4) 1020*1025*1025  541 

1020  W RITE! IOUT*9550)NP  542 

NFLAG= 1  543 

1025  CONTINUE  279  544 


n  n  on 


I  F  {  T  I  oX • GE • 0 • ) GO  TO  1027  545 

WRITE  l  IOUT  *9590 ) NP  546 

T  I  3X  =  ABS ( T IoX )  547 

1027  I F ( T I uY • GE . 0 • ) GO  TO  1029  548 

WRITE  l  IOUT  *9590)  in  P  549 

T  I  3Y  =  ABS ( T I  BY )  550 

1029  IFtTIBS.GE.O. )GC  TC  1031  531 

WRITE  (  I  OUT  ,9600  )  ivi  P  552 

T  I6S  =  A5S( TIBS)  553 

1031  IF(TX.GE.G.)GC  TO  1033  554 

wRITE!  I  OUT  *5600)  NP  5^5 

TX=A55 ( TX )  556 

1033  IFITY.GE.0. ) GO  TC  1035  557 

•vRITE!  IOUT  *9600)  NP  558 

T Y=Ad5 ( T  Y )  559 

io35  i F ( TO • GE • 0 • ) GO  TO  1037  560 

WRITE! I0UT*9600)NP  561 

T  0=ABS ( TO )  562 

1037  IFITS.GE.0. ) GO  TC  1050  563 

WRITE!  IOUT  *9600)  \P  564 

T  5  =  A5S ( T  S )  565 

1050  CGNT  I  i'lOE  566 


WRITE!  IOUT  *9001)  N  P  *  \l»N2»N3*N4*TO*TX»TlBXtTY*TIBY*TS*TIBS*EM*G 

I F ( 1 b U  G  • N  E  »  0)  W R I T  E (  I C  U  T  *  6  0  0  0  )  TRS1*TRS2*TRS3 

LINE=LINE+2 

IF(LINE*lT*50)GO  TC  10 
CALL  PAGHED 
L  I  iC  c  —  0 

WRITE! ICUT.9GCG  )  < I  I ♦ I  1  =  1 *4) 

10  CONTINUE 


M  =  N 1  56  7 

XS1=XN!M)  566 

Y  S 1  =  Y  N ( M )  569 

ZS1=ZN!M)  570 

C  571 

.'•i=N2  572 

XS2=XNltf>  573 

YS2  =  YMi'1)  574 

ZS2=ZN(M)  575 

C  576 

M  =  N  3  5  77 

XS3=XN  ( i-1 )  578 

YS3=YN(M)  579 

ZS3sZN ( M )  5  So 

C  531 

N 5  =  N  4  5  3  2 

I F ( N 5 • EQ » 0 ) GO  TO  1127  583 

X  S  4 = X  N  <  N 5 )  584 

YS4  =  YN(i'!5)  535 

Z S 4  =  Z •'i  ( i"4 5  )  5  86 

1127  CONTINUE  587 

556 
559 

DO  11=1*30  590 

DO  1  J  =  1  *30  591 

SK.35S  (  I  *J)=C#0 

1  SKG ( I  * J i =0.0  592 

593 

CALL  THE  GENERATION  OF  THE  STIFFNcSS  AND  FIXED  END  FORCES  594 

Call  pstif(lin^) 

7 06  CONT I ^JE 
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on  non 


IF(LINE.LT.50)GO  TO  21 

LINE=0 

CALL  PAGHED 

WRITE! IOUT  *9000 ) ( I  I • I  1  =  1 *4) 

21  CONTINUE 

IF(KRENT.NE.O)  GO  TO  1002  596 

I  F (  I  SWAP  * EQ • 0 )  GO  TO  1251  597 

NSAVE-N3  598 

N3=N4  599 

N4-NSAVE  600 

KSWAP= 1  601 

GO  TO  10 

1251  CONTINUE  603 

C  604 

1002  CONTINUE  6C5 

CONNECTIVITY  INFO  FOR  PLATE  606 

607 

608 

MPT= I P  T- 1  609 

DO  1129  I  =  1 >MPT  610 

IF((N1.LE.LN(I  +  11) .AND.  I N 1 . GT . LN ( I )  )  ) N I ■ I +1  61 1 

1 F ( (N2.LE.LNt  I  + 1 ) ) .AND. ( N2 . GT . LN ( I )  ) ) N J= I +1  612 

I  F (  (N3.LE.LN( I  + 1 )  ) .AND.  ( N3 . GT . LN ( I )  )  )NK»I+1  613 

IF( (N4.LE.LN( I+l ) ) .AND. ( N4. GT . LN ( I ) ) )NL=I+1  614 

IF(Nl.LE.LNll) )NI=1  615 

IF(N2.LE.LN(1) )NJ=1  616 

IF(N3.LE.LN(1) )NA=1  617 

IF(N4.LE.LN(1) )NL=i  618 

1129  CONTINUE  619 

LL=o  620 

NN ( 1 ) =100 1*NI  621 

NN ( 2 )  =  I  CON ( N J  *  N  I  )  6 22 

NN ( 3 ) = 100  1*NJ  623 

NN ( 4 )  =  I  CON  t  NK  »N I )  624 

NN ( 5 ) = 1  CON ( NK » NJ )  625 

NN(6)=1001*NK  626 

IF(N4.EQ.O)GO  TO  1132  627 

NN ( 7 )  =  I  CON ( NL  »N I )  628 

NN ( 3 )  =  I  CON ( NL • N J )  629 

NN ( 9 ) = I  CON ( NL  »NK )  630 

NN ( 10 ) ■lOOl^NL  631 

LL= 1 0  632 

1132  CONTINUE  633 

DO  1135  J= 1 . LL  634 

DO  1134  1  =  1  *  K 1  635 

I  I  =  I  636 

IF( JPART ( I ) .EO.NN ( J ) ) GO  TO  1135  637 

1134  CONTINUE  638 

I  I «K 1  639 

K1»K1+1  640 

JPART ( I  I ) =NN< J )  641 

LPART( II )*10001*NP  642 

1135  LPART( 1 1 )  =  ( LPART ( I  I ) /10000) *10000+NP  643 

NPS»'<1-1  644 

645 

CALL  FOR  6X6  TRANSFORMATION  646 

CALL  PMTR  647 

C  648 

C  CALL  FOR  STRESS  TRANSFORMATION  649 

CALL  SMTR  650 

c  281  651 


nn  rmnnno  r>  r»  n  no  o  o  o  o  o  o  o 


652 

667 

668 


C 

L  I M  =  1 8 

IF1N4.NE.0 ) LIM=24 

C  *  *  #  TRANSFORMATION-  K. ( LAMBDA- T )  *  *  * 

C 

CALL  KLAMT(SKQSS*PT) 

C 

*  *  *  GENERATE  STRESS  MATRIX  *  *  * 


DO  1275  1=1*8 

691 

DO  1275  J=1 *24 

P  I  (  I  •  J  )  =  0 . 0 

693 

694 

CALL  M U L 1 ( G T *SKGSS*PI *1 »8*LIM»LIM*8 *30*8 ) 


I  F ( I 5UC  )  1276*1277  *1276 

1276  CALL  KLAMT ( SKQ  *  PT ) 

GO  TO  1279 

1277  00  1  2  76  1  =  1*30 
DO  1276  J=l*30 

1278  SKG( I  *J ) =SKQSS (  I  * J ) 

*  *  *  COMPLETE  COORD.  TRANSFORMATION  -  LAMBDA  t  K#LAMDA-T )  *  *  * 


1279  CALL  LAMK ( SKQ  »  PT ) 

WRITING  STIFFNESS  676 

679 

WRITE ( KSOLN ) N 1 *N2*N3*N4  680 

661 

WRITE(KSOLN)  !  (  SK.G  (  J  *  I  )  *  J  =  1  *  6  1  *  I  =  1  »  6  )  *  682 

1  t ( SKQ ( J *  I  )  * J =  1*  6)*I=  7*12)  *(  ( SKQ ( J  *  I )  *J=  1*  6)  *1  =  13*16)  •  683 

2((SKG(J*I)*J=  1*  6)  *1  =  19*24)  *((SKQ(J*I)*J  =  7*12)  *  I  =  1*  6)*  684 

3<  (SKQCJ*  I  )  »J=  7*121*1=  7 1 1 2  )  * (  ( SKG ( J *  I )  * J  =  7  *  12  )  »  I  =  13  *  18  )  »  685 

4  (  (  SKQ  (  J  *  I  )  *  J=  7.12  )*  1=19*24)  •(  {  SKQ  (  J  *1  )  *J  =  13*18  )*  1=  1*  6)»  686 

5(  (  SKQ  {  J  *  I  )  •  J  =  13*18)  *1=  7*12)  *((SKQ(J*I)*J  =  13*18)  *1  =  13*18)*  687 

6  !  t SKG ( J *  I  )  ♦  J* 13 » 1 6 ) *  I  = 1 5  *  24  !  * (  ( SKG ( J *  I )  » J  =  19  *  24  )  *  I =  1*  6)*  688 

7(  (  Sis  Q  (  J  *  I  )  *J  =  19»24)  *1=  7*12)  *  (  (  S  <  Q  (  J  »  I  )  »J  =  19*24)  *1  =  13*18)  *  689 

6(  ( SKQ  t J* I ) . J= IS . 24).  1  =  19*24)  690 

WR I T I NG  STR ESS  697 

698 

W  R I T  E ( I S  T  R  S ) N  P  »  N 1  *  N  2  *  N  3  *  N  4  69  9 

WRITE(I$TRS)((FI(I*J)*I=1*8)*J=1*24)  700 

701 

702 

I  F  (  IO.NE.DGO  TO  1260  703 

PRINT  OPTIONS  FOR  INDIVIDUAL  PLATE  704 

CALL  PRINT ( GT  *  3 . L IM . 1 , 4HSMTR  *  1 . 8 )  706 

CALL  PR  I  NT ( SAG • L I M * L I M » 1  * 4HST I F » 1 • 30  )  707 

CALL  PRINi  ( P I  *  8  *  L I M  *  1  *  4HSTRS  *  1  *  8 )  708 

1260  CONTINUE  709 


710 

711 
763 
808 

809 

810 

I  F  (NPLATE-NT  )  2  003  *200  3  *  1001  8U 

812 
8  1 3 

2003  CONTINUE  gi4 

8  1 5 

6000  FORMAT ( 15X* 10HSIGMA-X  =  * E12 • 5  * 3X • 10HSI GMA-Y  =  * E 1 2 . 5 . 3X . 9HT AU-X Y 
*  =  *  E 1 2  •  5  ) 

9000  FORMAT(/36X*10HPLATE  DATA// 
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1  IX.  6H  PLATE .4 ( 5H  NODE  ) . 4X.4HT (0) »7X • 4HT ( X ) »7X  »4HI (X) »7X. 

2  4HT (YJ.7X.4H I (Y) #7X .4HT ( S) .7X.4HI (S) .9X.1HE.7X .5HGAMMA//5X .41 5//  ) 


9001  FORMATUX. 515.91  1PE11. 3)  ) 

9500  FORMAT (7I4.4X. I2.2X.3E12.4) 

9501  FORMAT ( 6E12 . 4 ) 

9502  FORMAT  ( 7E10.4 | 

9550  FORMAT ( 34H1 I NCORRECT  NODE  NUMBER#  PLATE  NO.  14)  819 

9560  F0RMATI43H1NEGATIVE  MODULUS  OF  ELASTICITY.  PLATE  NO.  14)  82o 

9370  FORMAT ( 35H1NEGAT I VE  POISSON  RATIO,  PLATE  NO.  14)  82i 

95*0  FORMAT (41H1INPUT  NOT  IN  PROPER  SEQUENCE.  PLATE  NO.  14.  822 

11 1H  SHOULD  BE  14)  823 

9390  FORMAT (38H1NEGATIVE  MOMENT  OF  INTERTIA. PLATE  NO.  14)  824 

9600  FORMAT (31H1NEGAT I VE  THICKNESS.  PLATE  NO.  14)  825 

C  826 

RETURN  827 

END 
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SUBROUTINE  MUL1 


SIBFTC  MUL1*  DECK 

SUBROUTINE  MUL1 ( A *B »C .NT *N1 • N2 #N3 » I D 1 • I D2 . ID3 )  83l 

832 

NT«1  C«A*B  833 

LIMITS  OF  MULTIPLY  A(N1.N2)  BIN2.N3)  CIN1.N3)  834 

835 

DIMENSION  A< 101*1) *B< 102*1 ) *C< 103*1 )  836 

C  837 

DO  100  I  ■  1 » N 1  838 

DO  100  J-1.N3  839 

C(I#J)-0.0  840 

DO  100  K-1.N2  841 

100  C( I.JI-CI I*J)»AI I*K)*B(K»J)  842 

400  RETURN  843 

END  844 
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SUBROUTINE  MUL2 


S IBFTC  MUL2*  DECK 

SUBROUTINE  MUL2 I A»B*C»NT*N1 *N2 *N3 * ID1 *  102 # ID3 ) 


NT-2  C-A I  TRANSPOSE »*B 

LIMITS  OF  MULTIPLY  A(N1*N2>  B(N2*N3)  CIN1#N3) 

DIMENSION  A(ID1*1» *81102*1) »CUD3*1> 

C 

DO  300  I -1 *N1 
DO  300  J-l *N3 
C(I*J)-0.0 
DO  300  K-l *N2 

300  CII*J)-CU»JH-AIK*I>*B(K*J) 

C 

400  RETURN 
END 


847 

848 

849 

850 
8&1 

852 

853 

854 

855 

856 

857 

858 

859 

860 
861 
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n  no  n n  non  r>  r>  r\  r>  r> 


SUBROUTINE  PSTIF 


SIBFTC  PSTIF*  DECK 

SUBROUTINE  PSTIF(LINE) 

COMMON/RENT/NRENT  *KRENT  865 

C0MM0N/TPLN1/NERR  882 

COMMON/PST  I FL/ I  SWAP  886 

COMMON/PSTIF9/NP  *N4 

888 
890 

FORM  LOCAL  COORDINATES  FROM  STRUCTURAL  COORDINATES  891 

FOR  TRIANGULAR  OR  QUADRILATERAL  PLATE  892 

893 

CALL  LOCAL  894 

IFIKRENT.NE.OIGO  TO  2  895 

IFIISWAP.NE.OIGO  TO  150  896 

2  CONTINUE  897 

905 

FOR  ANALYSIS  OF  TRIANGULAR  PLATE#  N4-0  906 

907 

I F ( N4#NE #0 ) GO  TO  130  908 

10  CALL  TRI  909 

GO  TO  150  996 

947 

FOR  ANALYSIS  OF  QUADRILATERAL  PLATE#  N4  DOES  NOT  EQUAL  0  948 

949 

CHECK  COPLANARITY  OF  QUADRILATERAL  PLATE  950 

951 

130  CALL  COPLAN ( NERR )  952 

CALL  QUAD! LINE) 

150  RETURN  954 

END  957 
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SUBROUTINE  QUAD 


$  I  BFTC  QUAD*  DECK 

SUBROUTINE  QUAD (LINE) 

C  961 

C  GENERATE  STIFFNESS  AND  TEMPERATURE  LOADS  FOR  QUADRILATERAL  PLATE  962 

C  963 

COMMON /P ST IF2/H»TS  964 

COMMON /ADPRO/E * GAMMA  * DUM1 * DUM2  #DUM3  *DUM4  965 

COMMON/PST  I F3/X1 *Y1 *X2  *Y2*X3*Y3  966 

COMMON /P ST IF5/TLQADI18) iDEFLtlS)  967 

COMMON /P ST IF8/SKQ (30*30)  968 

COMMON /PST  I FH/X LI *YL1*XL2*YL2*XL3*YL3*XL4*YL4  969 

COMMON/PSTIFK/NQUA  970 

COMMON/PSTIFL/ ISWAP  971 

COMMON/ TEMP2/ A  l  9  >40 )  972 

COMMON/ TPLN1/NERR  973 

COMMON/RENT/NRENT  977 

COMMON/SWAP/KSWAP  978 

COMMON/LOAD/LDPT  979 

COMMON /PSTRSS/SKQSS ( 30  *  3C ) 

COMMON/BUCK/ IBUC 

EQU I  VALENCE (XYL  < 1 ) *  XL  1 )  • C  XY ( 1 )  *  X2 )  980 

DIMENSION  XYL(8) *XY(4)  982 

C  983 

C  FIND  FIFTH  NODE  984 

C  985 

XL23=XL2-XL3  986 

P34=XL4*YL3+YL4*XL23  987 

X1=(XL4+XL3+(XL2*YL4*XL23/P34) )/3*0  988 

Yl=( YL4+YL3-(XL2*YL4*YL3/P34) ) /3.0  989 

C  990 

C  ZERO  THE  ELEMENTS  OF  SKG(3C*3C>  991 

C  992 

DO  1C  U  =  1 1 3 C  993 

DO  10  1=1*30  994 

1C  S KQ ( I » J ) =0.0  995 

C  996 

C  SUBDIVIDED  TRIANGULAR  PLATES  OF  THE  QUADRILATERAL  PLATE  1038 

C  1039 

19  DC  24C  NQUA= 1 » 4  1040 

DO  90  1=1*4  1041 

GO  TO ( 50*20*30*40) *NQUA  1042 

20  GO  TO ( 60  *60 *70  *70  )♦  I  1043 

30  GO  T0(80*8 0.60*60)  *1  1044 

40  GO  T0(70*70»81»81)  *1  1045 

50  1 1- I  1046 

GO  TO  85  1047 

60  11=1+2  1048 

GO  TO  85  1049 

70  11=1+4  1050 

GO  TO  85  1051 

80  11=1+6  1052 

GO  TO  85  1053 

81  11=1-2  1054 

85  X  Y  (  I  )=XYL(  ID  1055 

90  CONTINUE  1056 

CALL  TRI  1057 

240  CONTINUE  1133 

C  1134 

C  REDUCE  OUT  FIFTH  NODE  FROM  STIFFNESS  MATRIX  SKQ(30*30)  1135 

C  1137 


DO  246  K  =  25  *  30 
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246 

CALL  REDUCE(SKQSS*30*K) 

I F ( I BUC«  EQ • 0 ) GO  TO  280 

DO  245  K  =  25  »  30 

1138 

245 

CALL  REDUCE(SKQ.30*K) 

280 

RETURN 

1140 

END 

1141 

1144 

288 


SUBROUTINE  LAMK 


SIBFTC  LAMK*  DECK 

SUBROUTINE  LAMK ( SK *PT ) 

DIMENSION  SKI  3*300) *PT( 3*3) *P(3> 
DO  50  1=1*300 
DO  25  IR=1 *3 
PI IR)=0. 

DO  25  I C* 1  * 3 

PI  IR)=P( IR1+PTI IR*IC)*SK< IC.I ) 

25  CONTINUE 

DO  50  IC=1 *3 
SKI  IC.D-PIIC) 

50  CONTINUE 
RETURN 
END 


SUBROUTINE  KLAMT 


SIBFTC  KLAMT *  DECK 

SUBROUTINE  KLAMT (SK*PT ) 

DIMENSION  SK(30»3|10) •  P  T  (  3  *  3  )  *P ( 3 ) 

DO  50  I=ltlO 

DO  50  J=l»30 

DO  25  I R» 1 # 3 

PIIRI-0.0 

DO  25  IC«1*3 

P ( I R ) »P { IR)+PT(IR#IC)*SK(J#IC*I) 

25  CONTINUE 

DO  50  I Ca 1 • 3 
SK(J»IC.I)-P(ICI 
50  CONTINUE 
RETURN 
END 
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non  nnnn  n  nonnnnnnnn  noon 


SUBROUTINE  TRI 


$  I BFT C  TRI*  DECK 

SUBROUTINE  TRI  114? 

1148 

TRIANGULAR  PLATE  STIFFNESS  GENERATION  SK ( 18  •  1 8 )  1149 

1150 

1151 

COMMON /P ST IF1/SK(18»18)  1152 

COMMON /P ST IF3/X1»V1*X2*V2#X3»Y3  1153 

COMMON /P ST IF7/X21 »X3  1 *X32*Y21 *Y31*Y32  1154 

COMMON/PST  I F9/NP  *N4  1155 

COMMON/PSTIFH/XL1 *YL1 *XL2*YL2  *XL3*YL3*XL4*YL4  1156 

COMMON /P ST  I FD/TX*TY* TO 
COMMON /BUCK/ I BUC 


COMMON /T HR ST /TRS1*TRS2*TRS3*TRS4*TRS5*TRS6»TRS7 
COMMON /P REST /SKP RE (6 ) 


************* 

DEFINITION 

OF 

ARGUMENTS  * 

XI 

*  Y1  -  LOCAL 

COORDINATES 

AT 

NODE 

1 

OF 

X2 

*Y2  -  LOCAL 

COORDINATES 

AT 

NODE 

2 

OF 

X3 

*  Y3  -  LOCAL 

COORDINATES 

AT 

NODE 

3 

OF 

EQU I  VALENCE (XLOCAL* XL  1 ) 
DIMENSION  XLOCAL18) 

T  =  TO 


1157 

1158 

************ 

1159 

1160 

TRIANGULAR  PLATE 

1161 

TRIANGULAR  PLATE 

1162 

TRIANGULAR  PLATE 

1163 

1164 

1165 

1166 

1167 

1168 

I  F ( N4  «  NE • 0 ) GO  TO  5 
1  X 1 “XL  1 
Y1-YL1 
X2“XL2 
Y2“YL2 
X3“XL3 
Y3=YL3 

THE  FOLLOWING  PROJECTIONS*  (LENGTHS)* 
INPST  *OUTSH* INPM  AND  PTEMP 


5 

X  2 1 

fe 

X2 

-XI 

X31 

= 

X3 

-XI 

X32 

tt 

X3 

-X2 

Y21 

C 

Y  2 

-  Y 1 

Y31 

s 

Y3 

-Y1 

Y32 

S3 

Y3 

-Y2 

THE 

FOLLOW 

ING  ZERO  <  S  THE  SK  ARRAY 

DO 

10 

J  = 

1*18 

DO 

10 

1  = 

1*18 

10 

SK  ( 

I  1 J 

)  = 

0.0 

1169 

1170 

1171 

1172 

1173 

1174 

1175 

1176 

1177 

E  USED  IN  ROUTINES  1170 

1179 

1180 
1181 
1182 

1183 

1184 

1185 

1186 
1187 
1186 
1169 

1190 

1191 

1192 


C  GENERATE  K1  FOR  TRIANGULAR  ELEMENT 


I  F ( I BUC  *  EQ • 0 ) GO  TO  20 
IF(N4.EQ.O)  GO  TO  40 
XT2=SQRT ( X21**2  +  Y21**2) 

XT3= ( X2 1*X3 1  +  Y21*Y31)/XT2 
YT3=SQRT(X31**2  +  Y31**2  -  XT3**2) 
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XT32  =  XT3  -  XT2 
CES  =  X21/XT2 
SEN  =  Y21/XT2 
T4A=T/(2.*XT2*YT3) 

TS1T=T4A*TRS1 

TS2T=T4A#TRS2 

TS3T=T4A*TRS3 

TS1= ( f CES**2 ) *TS1T  +  ( SEN**2 ) *TS2T  +  2 #*{ S EN*CES ) #TS3 T ) 
TS2= ( ( SEN**2 ) *TS IT  +  ( CES**2 ) *TS2T  -  2«*(SEN*CES)*TS3T) 
TS3=  (  (  SEN*CES  )  *  (  TS2T-TS1  T  )  +  (  CES**2“SEN**2  )  *TS3T  ) 

GO  TO  19 
40  XT 2  =  X2 
XT3=X3 
YT3=Y3 
XT  32  =  X32 

T4A=T/(2.*XT2*YT3) 

TS 1  =  T  4A*TRS 1 
TS2=T4A*TRS2 
TS3  =  T  4A#TRS3 

19  SK.PRE(1)=TS1*YT3*YT3  +  TS2*XT32*XT32“TS3*2»-:('XT32*YT3 
SKPRE(2)=-TSl*YT3*YT3-TS2*XT32*XT3+TS3*YT3*(XT3+XT32) 
SKPRE ( 3 )  =TSl*YT3*YT3+TS2*XT3*XT3-TS3*2»*XT3*YT3 
SKPRE  (4)  =TS2*XT32*XT2-TS3*XT2*YT3 

SKPRE ( 5 )  =-TS2*XT3*XT2+TS3*XT2*YT3 
SKPRE ( 6 )  =TS2*XT2*XT2 

20  CONTINUE 


C 


C 


generate  stiffness  for  in-plane  effects  (inpj 

CALL  INP 
CALL  STORE ( 2 ) 


GENERATE  STIFrNESS  FOR  OUT  OF  PLANE  EFFECTS  (OUTP) 

CALL  OUTP 
CALL  STORE ( 0 ) 

100  RETURN 
END 


1193 

1194 

1195 

1196 

1197 

1198 

1199 

1200 
1201 
1202 

1204 

1205 

1206 
1207 
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SUBROUTINE  INP 


SIBFTC  INP*  DECK 

SUBROUTINE  INP  1210 

COMMON /P ST IFA/SK66(6*6)/PSTIFB/SK99(9*9)  12  H 

1212 

♦a****************************************************************  1213 

GENERATE  STIFFNESS  FOR  IN-PLANE  EFFECTS  (INP)  FOR  TRIANGULAR  PLATE  1214 

******************************************************************  1215 

1216 
1217 

GENERATE  STIFFNESS  FOR  IN-PLANE  STRETCHING  (INPS)  1218 

1219 

CALL  INPST(l)  1220 

1221 

GENERATE  STIFFNESS  FOR  IN-PLANE  MOMENTS  (INPM)  1222 

1223 

CALL  INPM  1224 

1225 

COMBINE  (INPST)  AND  (INPM)  STIFFNESS  INTO  (INP)  STIFFNESS  1226 

1227 

CALL  COMB  IN ( 1 )  122fl 

RETURN  1229 

END  1230 
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SUBROUTINE  INPM 


SIBFTC  INPM*  DECK 

SUBROUTINE  INPM  1233 

C  1234 

C  GENERATE  THE  STIFFNESS  CONTRIBUTION  DUE  TO  1235 

C  IN-PLANE  MOMENTS  IN  THE  ELEMENTS  OF  UPPER  TRIANGLE  OF  SK99  1236 

C  1237 

COMMON /P ST IF2/H*TS  1238 

COMMON/ ADPRO/E* GAMMA. DUM1 * DUM2 *DUM3 , DUM4  1239 

COMMON /P ST IF7/X21*X31*X32*Y21*Y31*Y32  12^0 

COMMON /P  ST IF9/NP*N4  1241 

COMMON/PST IFB/SK99(9*9)  1242 

COMMON /P ST IFD/TX*TY*TO  1243 

C  1244 

DIMENSION  XY<3*2) *D(3) *SC<3.2) *SC2(3.2) *E2AI (3) .  1245 

*  ADI  3)  *  IDO)  •  1 02(3)  *  I D3 I  3 ) • I D2SC I  3 ♦ 2  > • I D3SC2 I  3 *2 )  *ADSC2  t  3  *2  )  *  A I  13)  1246 

C  1247 

EQUIVALENCE  I X2 1 *XY I  1 . 1  )  )  1248 

REAL  ID,ID2.ID3.ID2SC,ID3SC2  1249 

TXY I  A ) »0 • 5* I ITX+T0)*(1.0+(A) ) ft TX+TO  )  * ( 1 . 0“ I A ))) *A2  12  50 

C  1251 

A2=(X21*Y31-Y21*X31)/6.0  1252 

T01=ITO/12.0)*A2**3  1253 

C  1254 

E2  =  E  1255 

E4«2  «  *E  1256 

E8=4.*E  1257 

E12“6.*E  1258 

E24»12.*E  1239 

1260 
1261 

Dll)  IS  D12.  ETC.  1262 

1263 

DO  10  1=1*3  1264 

10  D(I)=SQRT<XY(I.1)**2+XYII*2>**2)  1265 

1266 

SCIlfl)  IS  S IN12  *SC  (1*2)  IS  C0S12 »  ETC*  1267 

1268 

DO  20  J=1 *2  1269 

DO  20  1=1*3  1270 

20  SCI  I *J) =XY( I *J)/D( I )  1271 

SC  I  2  *  1 ) =-SC (2*1)  1272 

SC(2*2)=-SC(2*2)  1273 

1274 

SC2 (1*1)  IS  SIN12**2*  ETC.  1275 

1276 

DO  30  J= 1 *2  1277 

DO  30  1=1*3  1278 

30  SC2I I *J) =SC( I * J ) **2  1279 

1260 

AD  I  1 )  IS  A12/D12*  ETC.  1281 

1282 

DO  50  1=1.3  1283 

50  ADI  I ) =0.  1284 

1285 

10(1)  IS  I12/D12.  ETC.  1286 

1287 

DO  60  1=1*3  1288 
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60  ID< I >=T01/(D<  I  )**4) 

102(1)  IS  112/(012**2).  ETC. 

DO  70  1=1*3 
70  1 02 ( I >  =  ID( I )/D< I ) 

103(1)  IS  1 12/ ( D12**2 ) *  ETC. 

DO  80  1=1*3 
80  I  03 ( I ) “ 102 ( I ) /D (  I  ) 

I D2SC ( 1  *  1 )  IS  1 12*S IN12/ ( 012**2 ) •  ETC. 

DO  90  J  =  1  *2 
DO  90  1=1.3 

90  I02SC(I.J)=ID2(I)*SC(I.J) 

I D3SC2 (1.1)  IS  I 12*SIN12**2/(D12**3) .  ETC. 

DO  100  J  =  1 » 2 
DO  100  1=1.3 

100  I03SC2 ( I .J)«ID3< I )*SC2< I .J) 

ADSC2 (1.1)  IS  A12*SIN12**2/D12*  ETC. 

DO  110  J= 1 .2 
DO  110  1=1.3 

110  ADSC2( I .J)=A0( I )*SC2< I *J) 

E2AI(1)  IS  2*E*(SIN12*COS12*< A12/D12-I 12/ ( D12**3 ) ) ) *  ETC. 
DO  120  1=1.3 

120  E2 A I ( I )=SC( I .1 )*SC( I .2 )*< AD( I >-12.0* ID3< I ) )*E2 
ROW1 


SK99 ( 1.1) 
SK9911.2) 
SK.9911.3) 
SK99I 1 *4) 
SK99I 1 .5 ) 
SK99I1.6) 
SK.99I  1.7) 
SK99 ( 1  .8 ) 
SK.99I  1.9) 


E8* ( 1 0 ( 1 )  +  I D ( 2 )  ) 

E 1 2* ( ID2SC( 1 .2  )  -  I D2SC ( 2  » 2  )  ) 
E 1 2* ( ID2SC( 1.1  )  -  ID2SC( 2*1)) 
E4* I D ( 1 ) 

E12*ID2SC(1.2) 

E 1 2* I D2$C ( 1 . 1 ) 

E4* I D ( 2 ) 

E 1 2*1 D2SC ( 2  *2 ) 

E12*I D2SC (2.1) 


R0W2 


SK99  (2.2) 

SK99 (2.3) 
SK.9912.4) 
SK99  (2*5) 
SK99  (2*6) 
SH99 (2*7) 
SK99 (2.8) 
SK99I 2.9) 


E2* ( ADSC2 (1.1)  *  ADSC2 (2.1))  + 
E24*( ID3SC2I1.2)  +  ID3SC2(2*2)) 
E2AI (1)  +  E2A I (2) 

SK99U.5) 

E2* (ADSC2 (1*1)  *  12.0*ID3SC2(1.2) > 
E2AI (1) 

SK9911.8) 

E2* ( ADSC2 (2*1)  ♦  12 • 0* I D3SC2 ( 2  * 2 ) ) 
E2AI (2) 


R0W3 


1289 

1290 

1291 

1292 

1293 

1294 

1295 

1296 

1297 

1298 

1299 

1300 

1301 

1302 

1303 

1304 

1305 

1306 

1307 

1308 

1309 

1310 

1311 

1312 

1313 

1314 

1315 

1316 

1317 

1318 

1319 

1320 

1321 

1322 

1323 

1324 

1325 

1326 

1327 

1328 

1329 

1330 

1331 

1332 

1333 

1334 

1335 

1336 

1337 

1338 

1339 

1340 

1341 

1342 

1343 

1344 

1345 

1346 

1347 
134e 
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C 

SK99  (  3*3)  » 

# 

SK99  (3*4)  - 
SK99 ( 3  *  5 )  = 
SK99 ( 3  »  6  )  = 
SK99  (3*7)  « 
SK99I3.8)  ■> 
SK99 ( 3  #9  )  * 

R0W4 

SK99(4.4)  ■ 

SK99 ( 4  #  5 )  = 
SK99  (4*6)  *= 
SK99  1  4  #  7  )  - 
SK99 (4.8)  - 
SK.99  (4*9)  - 

R0W5 

SK99 ( 5  •  5  )  - 

* 

SK99 (5*6)  « 
SK99 ( 5  »  7  )  * 
SK99  t  5  » 8  )  ■» 
SK99 (5*9)  - 

R0W6 

SK99 ( 6  » 6 )  - 

• 

SK99 (6*7)  ■ 
SK99 ( 6  t8 )  * 
SK99 (6*9)  ■ 

R0W7 

SK99 (7*7)  - 
SK99 (7*8)  - 
SK99 (7*9)  » 

R0W8 

SK99 ( 8  » 8  )  - 

SK99 (8*9)  ■ 

R0W9 

SK99 ( 9  »9  )  - 
C 

200  RETURN 
END 


E2* (ADSC2 ( 1 .2 )  4 
E24*( ID3SC2(1*1) 

-  SK99( 1 .6) 

-  E2AI ( 1) 

-  E2* ( ADSC2 (1.2)  + 

-  SK99 (1*9) 

-  E2AI (2) 

-  E 2* ( ADSC2 ( 2  * 2  )  + 


£2*  t ADSC2 (1*2)  + 
E24*( I D3SC2 ( 1  •  1 ) 

-  SK99 (4*9) 

-  E2AI (3) 

-  E2*  t  ADSC2 (3.2)  + 


+  E2* ( ADSC2 ( 2*2 )  + 
E24* ( I D3SC2 (2*1) 


ADSC  2 ( 2  i  2  )  )  + 
t-  ID3SC2  (2*1)) 

12.0*  ID3SC2 (1*1) > 

12.0*ID3SC2(2*1) ) 


ADSC2 (3.2) )  + 

+  ID3SC2 (3.1)) 

12.0*ID3SC2(3»1) ) 


ADSC2 (3.2)1  * 
4  1D3SC2 (3.1)) 


E  8* ( I D ( 1 )  +  10(3) ) 

-  El  2* ( I D2SC ( 3 . 2  )  -  ID2SC(1*2)) 
E 1 2* ( 1D2SC (3.1)  -  I D2SC ( 1 . 1 ) > 
E4*ID<  3) 

E12*ID2SC(3.2) 

-  E 1 2* I D2SC (3.1) 


E2* ( ADSC2 (1.1)  +  ADSC2 (3.1) )  + 
E24*( ID3SC2(1»2)  4  ID3SC213.2)) 
E2AI ( 1)  4  E2A I (3) 

-  SK99 ( 4 . 8 ) 

-  E2* ( ADSC2 (3.1)  4  12 . 0*  ID3SC2 ( 3 . 2 ) ) 

-  E2AI (3) 


E8*( 10(2)  ♦  10(3) ) 

-  E12*( ID2SC12.2)  -  ID2SCI3.2)) 
-E12*( ID2SC13.1  )  -  I D2SC ( 2 . 1 ) ) 


E2* ( A0SC2 (3.1)  4  ADSC2 (2.1))  + 
E24*< I03SC2 ( 3 .2 )  4  ID3SC2(2»2)) 
E2AI (2)  4  E2A I (3) 


1349 
1 3  bo 

1 3b  1 

1332 

1333 

1334 

1335 

1336 

1337 
1330 
1339 

1360 

1361 

1362 

1363 

1364 

1365 

1366 

1367 

1368 

1369 

1370 

1371 

1372 

1373 

1374 

1375 

1376 

1377 

1378 

1379 

1380 

1381 

1382 

1383 

1384 

1385 

1386 

1387 

1388 

1389 

1390 

1391 

1392 

1393 

1394 

1395 

1396 

1397 

1398 

1399 

1400 

1401 

1402 

1403 
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SUBROUTINE  INPST 


SlBFTC  INPST*  DECK 

SUBROUTINE  INPST(N) 

generate  stiffness  for  in-plane  stretching  in  upper  triangle 

OF  SK66 ( I  »  J  )  ELEMENTS. 


N» I i  GENERATE  (INPST) 

N«0.  GENERATE  (OUTPM) 

COMMON/P ST  I F2/H.TS 

COMMON/ ADPRO/E .GAMMA »DUM1 #DUM2  *DUM3  * DUM4 

COMMON/PST  I F7/X21.X31.X 32. Y21.Y31.Y32 

COMMON/P ST  I F9/NP.N4 

COMMON /P ST IFA/SK6616.6  I 

COMMON /P ST  I FC/T I BX.T I  BY.  TIBS 

COMMON /P ST IFD/TX.TY .TO 

PHI  =  E/(ABS(X21*Y31-Y21*X31 )*( 1 • 0“GAMMA**2 ) *2 .0 ) 
IF(N.EQ.O)  CO  TO  10 
T 1  =  (0.5*TO*< 1.0-GAMMA) )*PHI 
T2  =  ( 0.5*TO*< 1 .0+GAMMA ) ) *PHI 
GAT  =  GAMMA*TO*PHI 
IPX  =  ( TO+TX* ( 1 . 0-GAMMA **2 ) ) *PHI 
TPY  =  ( TO+TY* ( 1 .0-GAMMA** 2 ) ) *PHI 
GO  TO  20 
10  T OX  =  T I BS 

T 1  *  (0. 5*TOX*(l. 0-GAMMA) )*PHI 
T2  *  l 0 • 5*TOX* ( 1 .0+GAMMA ) ) *PHI 
GAT  *  GAMMA*TOX*PHI 

TPX  =  ( TOX+T IBX* ( 1 .0-GAMMA* *2 ) ) *PHI 
TPY  =  (T0X+TIBY*( 1.0-GAMMA**2) )*PHI 


ROW  1 


20  SK66 (1.1) 
SK6611.2) 
SK66 (1.3) 
SK66( 1.4) 
SK66U.5) 
SK66I1.6) 


TPX*Y32**2  + 

TPX*Y31*Y32  - 
GAT*X31*Y32  + 
TPX*Y21*Y32  + 
GAT*X21*Y32  - 


T 1*X32**2 
T2*X32*Y32 
T 1*X3 1*X  32 
T1*Y31*X32 
T 1*X2 1*X  32 
T1*Y21*X32 


ROW  2 

SK66 (2.2) 
SK66I2.3) 
SK66 (2.4) 
SK66  (.2.5) 
SK66 (2.6) 


TPY*X32**2  + 
GAT*Y3 1*X  32  + 
TPY*X31*X32  - 
GAT*Y 2 1*X 32  - 
TPY*X21*X32  ♦ 


T1*Y32**2 
T1*X31*Y32 
T1*Y31*Y32 
T1*X2 1*Y32 
T1*Y21*Y32 


ROW  3 


SK66I3.3)  - 
SK66 (3.4)  - 
SK6613.5)  - 
SK66I3.6)  - 


TPX*Y3 1**2  + 

TPX*Y21*Y31  - 
GAT  *X21*Y  3 1  + 


T 1*X31**2 
T2*X31*Y31 
T1*X21*X31 
Tl*Y21*X31 


ROW  4 


1406 

1407 

1408 

1409 

1410 

1411 

1412 

1413 

1414 

1415 

1416 

1417 

1418 

1419 
14^0 

1421 

1422 
140 

1424 

1425 

1426 

1427 

1428 

1429 

1430 

1431 

1432 

1433 

1434 

1435 

1436 

1437 

1438 

1439 

1440 

1441 

1442 

1443 

1444 

1445 

1446 

1447 

1448 

1449 

1450 

1451 

1452 

1453 

1454 

1455 

1456 

1457 

1458 

1459 

1460 

1461 
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SK66<4»4) 
SK66 (4*5) 
SK66 (4*6) 


TPY*X31**2  +  T1*Y31**2 

GAT*X31*Y21  t-  T1*X21*Y31 
TPY*X21*X31  -  T1*Y21*Y31 


ROW  3 

SK.66 (5*5) 
SK.66  (5*6) 


TPX*Y21**2  +  Tl*X21**2 

-T2*X21*Y21 


ROW  6 

SK66 (6*6)  •  TPY*X21**2  +  T1*Y21**2 

C 

200  RETURN 
END 


1462 

1463 

1464 

1465 

1466 

1467 

1468 

1469 

1470 

1471 

1472 

1473 

1474 

1475 

1476 

1477 
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SUBROUTINE  OUTP 


SIBFTC  OUTP*  DECK 

SUBROUTINE  OUTP 

COMMON/PST IFA/SK66 I  6 »6> /PST IFB/SK99I 9*9 ) 

****************************************************************** 
GENERATE  STIFFNESS  FOR  OUT  OF  PLANE  EFFECTS  (OUTP)  FOR  TRIANGULAR  PLAT 
•  ■a*#*#**********#**************************************'******'***** 


GENERATE  STIFFNESS  FOR  OUT  OF  PLANE  MOMENTS  (OUTPM) 

CALL  OUTPM 

GENERATE  STIFFNESS  FOR  OUT  OF  PLANE  SHEAR  (OUTPSH) 

CALL  OUTPSH 

COMBINE  (OUTPM)  ANO  (OUTPSH)  STIFFNESS  INTO  (OUTP)  STIFFNESS 

CALL  COMB IN  (0) 

RETURN 

END 


1480 

1481 

1482 

1483 
1464 

1485 

1486 

1487 

1488 

1489 

1490 

1491 

1492 

1493 

1494 

1495 

1496 

1497 

1498 

1499 

1500 
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SUBROUTINE  OUTPM 


SlBFTC  OUTPM*  DECK 

SUBROUTINE  OUTPM  1503 

1504 

GENERATE  STIFFNESS  FOR  OUT  OF  PLANE  MOMENTS  BY  TRANSFORMATION  1505 

OF  IN-PLANE  STRETCHING  STIFFNESS  MATRIX .  (SEE  SUBROUTINE  (INPST)It  1506 

OTHER  CHANGES  AS  INDICATED  BELOW  1507 

1508 

COMMON /P ST IFA/SK66I6.6)  1509 

COMMON/PST IFC/T I BX*T I  BY »T IBS  1510 

COMMON/PST  IFD/TX*TY*TO  15U 

1512 

1513 

CALL  INPST(O)  1514 

1=1  1515 

10  SAVE«SK66t I  *  1  )  1516 

SK66<I*I)=SK66l I+l.I+l)  1517 

SK66I I+1*I+1)=SAVE  1518 

SK66( I .1+1) «-SK66( I .1+1 )  1519 

1=1+2  1520 

IFtI.LE.5)  GO  TO  10  152l 

J=3  1522 

20  1=1  1523 

30  SAVE-SK66I I »J)  1524 

SK66I I . J1-SK66 ( I+l.J+1 )  1525 

SK66II+1.J+1) *SAVE  1526 

SAVE— SK66I  I  +  l.J)  1527 

SK66II  +  1.J)— SK66II.J+1)  152$ 

SK66I I»J+1)=SAVE  1529 

1=1+2  1530 

I F ( I ♦ LT • J ) GO  TO  30  1531 

J-J+2  1532 

IF( J.LE.5IGO  TO  20  1533 

RETURN  1534 

END  1535 
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SUBROUTINE  OUTPSH 


SIBFTC  OUTPS*  DECX 

SUBROUTINE  OUTPSH 


C  GENERATE  THE  STIFFNESS  CONTRIBUTION  DUE  TO  OUT  OF  PLANE 
C  SHEAR  (OUTPSH)  IN  THE  ELEMENTS  OF  SXQ( I »J»22  ) *SKQ( I  »J*23)  * 
C 

COMMON/PST  I F2/H*TS 

COMMON/ADPRO/E*GAMMA#DUMl »DUM2 *DUM3  *DUM4 
COMMON/ PST  IF 7/X 21 »X31#X32*Y21*Y31*Y32 
COMMON /P ST IFB/SX99(9*9) 


C 

C 

G  ■  E/ 
ALP  ■ 
ALP12 
ALP13 
ALP23 
C 

C  ROW1 
C 

SX99 ( 1 
SX99 ( 1 
SX99 ( 1 
SX99(1 
SX99 ( 1 
SX99  (  1 
SX99  < 1 
SX99I1 
SX99 ( 1 
C 

C  ROW2 
C 

5X99(2 
SK99I2 
SX99 ( 2 
SX99 ( 2 
SX99 ( 2 
SX99 ( 2 
SX99 ( 2 
SX99 ( 2 
C 

C  ROW3 
C 

SX99 ( 3 
SX99 ( 3 
SX99 ( 3 
SX99 ( 3 
SX99 ( 3 
SX99 ( 3 
SX99 ( 3 
C 

C  R0W4 
C 

SK99(4 
SX99 ( 4 
SX99 ( 4 
SX99 ( 4 


(2«0*(1.0  ♦  GAMMA) ) 
<G*TS)/(8.0*ABS(Y21*X31-Y3i»X21)) 

■  ALP*ABS(Y31*Y32+X31*X32) 

-  ALP*ABS(Y21*Y32+X21*X32) 

■  ALP*ABS(Y21*Y31+X21*X31) 


•  1) 
•  2) 

•  3) 
*4) 
*5) 
»6  ) 
»7 ) 

•  8) 
#9) 


ALP12*Y2 1#*2  ♦ 

( ALP12*X21*Y21 

2#0*(ALP12*Y21 

ALP12*Y21**2 

ALP12*X21*Y21 

2.0*ALP12*Y21 

ALP13*Y31*#2 

ALP13*X31*Y31 

2  «0*ALP13*Y31 


ALP13*Y31**2 
+  ALP13*X31*Y31) 
ALP13»Y31) 


#2)  -  ALP 12*X2 1**2  +  ALP13*X31**2 

♦3)  -  -  2.0*(ALP12*X21  ♦  ALP13*X31) 

•4)  •  -  ALP12*X21*Y21 

,5)  -  ALP12*X21**2 

•6)  -  2.0*ALP12*X21 

*7)  -  -  ALP 13*X31 *Y3 1 

•8)  -  ALP13*X31**2 

#9)  -  2.0*ALP13*X31 


*3)  ■  4  »0* ( ALP12+ALP13 ) 

»4)  -  2  «0*ALP12*Y21 

*5 )  ■  -  2  «0*ALP 12*X2 1 
» 6 )  ■  -  4  «0*ALP 12 
#7)  «  2.0*ALP13*Y31 

•8)  ■  -  2.0*ALP13*X31 
#9)  -  -  4.0*ALP13 


•4)  -  ALP12*Y21**2  ♦  ALP23*Y32**2 

•5)  ■  -  < ALP12*X21*Y21  ♦  ALP23*X32*Y32 ) 
,6)  -  -  2.0*(ALP12*Y21-ALP23*Y32) 

*7)  ■  ALP23*Y32**2 


1538 

1539 

1540 

1541 

1542 

1543 

1544 

1545 

1546 

1547 

1548 

1549 

1550 

1551 

1552 

1553 

1554 

1555 

1556 

1557 

1558 

1559 

1560 

1561 

1562 

1563 

1564 

1565 

1566 

1567 

1568 

1569 

1570 

1571 

1572 

1573 

1574 

1575 

1576 

1577 

1578 

1579 

1580 

1581 

1582 

1583 

1584 

1585 

1586 

1587 

1588 

1589 

1590 

1591 

1592 

1593 
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non  n  n  n  n  n  n  non  nnn 


SX99<4*8> 
SX99  (4*9) 

ROWS 

SX99 ( 5  * 5 ) 
SX99 (5*6) 
SX99 ( 5  #  7 ) 
SX99  (5*8) 
SIC99  <  5  *9  ) 


ALP23*X32*Y32 
2  .0*ALP23*Y32 


ALP12*X21**2+ALP23*X32**2 
2  •  0* ( ALP 12*X2 1—ALP23*X32  ) 
ALP23*X32*Y32 
ALP23*X32**2 
2  «0*ALP23*X32 


R0W6 

SX99 (6*6)  - 
SX99 (6*7)  ■ 
5X99(6*8)  ■  - 
SX99 (6*9)  •  - 


4.0*(ALP12  +  ALP23 ) 
2.0*ALP23*Y32 
2  *0*ALP23*X32 
4.0*ALP23 


R0W7 

SX99 (7*7)  -  ALP13*Y31**2+ALP23*Y32**2 

SX99 (7*8)  »  -(ALP13*X31*Y31  +  ALP23*X32*Y32 ) 
5X99(7*9)  ■  -2.0* <ALP13*Y31  ALP23*Y32) 


ROWS 


5X99(8*8) 
SX99 (8*9) 


ALP13*X31**2  +  ALP23*X32**2 
2 *0* ( ALP13*X31  +  ALP23*X32) 


ROW  9 


5X99(9*9)  -  4*0* ( ALP13  ♦  ALP23) 

RETURN 

END 


1594 

1595 

1596 

1597 

1598 

1599 

1600 
1601 
1602 

1603 

1604 

1605 

1606 

1607 

1608 

1609 

1610 
1 6 1 1 
1612 

1613 

1614 

1615 

1616 

1617 

1618 

1619 

1620 
1621 
1622 

1623 

1624 

1625 

1626 

1627 

1628 
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SUBROUTINE  COMBIN 


SIBFTC  COMBI*  DECK 

SUBROUTINE  COMB  I N  ( N  )  1631 

C  1632 

C  N-l.  WILL  COMBINE  IN-PLANE  STRETCHIN6  STIFFNESS  (INPST)  AND  1633 

C  IN-PLANE  MOMENT  STIFFNESS  (INPM)  IN  UPPER  TRIANGLE  OF  SK99  1634 

C  N»0 *  WILL  COMBINE  OUT  OF  PLANE  MOMENT  STIFFNESS  (OUTPM)  AND  1635 

C  OUT  OF  PLANE  SHEAR  STIFFNESS  1636 

C  1637 

C0MM0N/PSTIFA/SK66I6.6)  1638 

COMMON /PST  I FB/SK99 (9*9)  1639 

C  1640 

C  1641 

DO  40  1=1*6  1642 

Il-I+N  1643 

GO  TO  (20*20*10*10*25*25) *1  1644 

10  Il-I+N+1  1645 

GO  TO  20  1646 

25  U-I+N+2  1647 

20  DO  40  J  =  I  *6  1648 

J1*J+N  1649 

GO  TO  (40*40.30*30*35*35) *J  1650 

30  Jl-J+N+1  1651 

GO  TO  40  1652 

35  Jl-J+N+2  1653 

40  SK99 ( 1 1  * J1 )  •  SK99 ( 1 1 » J1 )  +  SK66(I»J)  1654 

C  1655 

C  PLACE  UPPER  TRIANGLE  OF  SK99  IN  LOWER  TRIANGLE  OF  SIC99  1656 

C  1657 

DO  50  1=1*8  1658 

K«I+1  1659 

DO  50  J=K*9  1660 

50  SK99(J*I)=SK99(I.J)  1661 

RETURN  1662 

END  1*63 
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SUBROUTINE  STORE 


SIBFTC  STORE*  DECK 

SUBROUTINE  STORE ( NT  EST )  1666 

C  TRANSFER  ELEMENTS  OF  (INF)  OR  (CUTP)  STIFFNESS  IN  THERE  1668 

C  INTERMEDIATE  MATRIX  TO  THEIR  PROPER  ELEMENTS  IN  SK (18*18)  1669 

C  FOR  THE  QUADRILATERAL  PLATE  ANALYSIS*  TRANSFER  ELEMENTS  1670 

C  OF  SK ( 1 8  » 1 8 )  TO  PROPER  ELEMENTS  OF  SKQ(30*30).  1671 

C0MM0N/PSTIF1/SK( 18  *18 )  1673 

C0MMON/PSTIF8/SKQ(30*30)  1674 

COMMON /P ST  I  F9/NP  *N4  1675 

COMMON /P  ST IFB/SK99(9*9)  1676 

COMMON/PSTIFK/NQUA  1677 

COMMON/PSTRSS/SKQSSI 30*30) 

COMMON /BUCK/ IBUC 
COMMON /P REST /SKP RE ( 6 ) 

C  NTEST  =  2  *  FOR  (INP)  1680 

C  NTEST  =0  *  FOR  (OUTP)  1681 

DO  701=1*9  I683 

M=I/4  1684 

I  F ( I »  EQ  •  7 ) M  =  2  1685 

II  =  1 +  3+M+NT  EST  1686 

IF(NTEST)30*10*30  1687 

10  GO  TO(30*30*20*30*3C*20*30*30*20)»I  1688 

20  11=11+3  1689 

30  DO  70  U  =  1  * 9  1690 

N=U/4  1691 

IF(U.EQ.7)N=2  1692 

U1=U+3*N+NTEST  1693 

I F ( NT EST ) 60  * 40  *  60  1694 

40  GO  TO ( 60 *60  *  50  *  60 t 60  *  50  *  60  *  60  *  50 )  * J  1695 

50  U 1=U 1+3  1696 

60  SKI  I  1  * J1 ) =SK99 (  I ♦ J ) 

70  CONTINUE  1698 

IF (NTEST. EQ. 2  )  GO  TO  200  1699 

C  TRANSFER  OF  ELEMENTS  FOR  QUADRILATERAL  1701 

I F ( N4* NE » 0 ) GO  TO  80  1703 

CALL  MOVE (SKI  1*1)  *SKQSS (1*1)*18*18*18*30) 

GO  TO  300 

80  CALL  MOVE! SK < 1 *1  )  .SKQSS ( 25  *25 )  .6  *6  *  18  *30  ) 

GO  T0(90*110*130*150) *NQUA  1708 

C  1ST  SUBDIVIDED  PLATE  OF  QUADRILATERAL  1710 

90  CALL  MOVE(SK(7. 7) *SKQSS( 1*1) *12.12*18.30) 

CALL  MOVE (SK( 1*7)  *SKQSS(25  *  1)  *6.12  *  18  *30) 

CALL  MOVE (SK( 7.1  )  *SKQSS (1.25).  12. 6. 18*30) 

GO  TO  300 

C  2ND  SUBDIVIDED  PLATE  OF  QUADRILATERAL  1717 


110  CALL  MOVE ( SK (  7.  7)*SKQSSl  7*  71.6.6*18*30) 

CALL  MOVE ( SK ( 13  *  7).SKQSS(19*  71*6*6*18*30) 

CALL  MOV  E ( SK (  1.  7)*SKQSS(25*  7 )  *  6  *  6  *  18  *  30  ) 

CALL  MOVE ( SK (  7*13)»SKQSS(  7  ♦  19  )  .6 *6  *  18 *30 ) 

CALL  MOVE ( SK ( 1 3  *  1 3  )  * SKQSS ( 1 9  *  1 9 )  .6*6*18*30) 

CALL  MOV E ( SK (  1  . 13 ) * SKQSS ( 2 5  *  1 9 )  .  6 . 6 . 18  *  30  ) 

CALL  MOVE ( SK (  7.  1). SKQSS!  7*251*6*6.18*30) 

CALL  MOVE ( SK ( 1 3  ♦  1 )  ♦  SKQSS ( 1 9  *  25 ) *  6  *  6  *  1 8  *  3 0 ) 

GO  TO  300 

C  3RD  SUBDIVIDED  PLATE  OF  QUADRILATERAL  1729 

130  CALL  MOVE(SK ( 13  . 13 )  .SKQSS ( 13  *  13 ) *6*6  *  18 *30 ) 

CALL  MOVE ( SK (  7 . 1 3 ) * SKQSS ( 1 9 . 1 3 )  *  6  *  6  *  1 S *  30 ) 

CALL  MOV E ( SK (  1  . 1 3  )  * SKQSS ( 2 5 . 1 3  )  *  6 , 6  *  1 8  *  30 ) 

CALL  MOVE ( SK ( 1 3  *  7 )  . SKQSS ( 1 3 . 1 9 )  . 6 . 6  *  1 8  *  30 ) 

CALL  MOVE l SK (  7.  7 )  . SKQSS ( 1 9 . 1 9  )  . 6 . 6 . 1 8  *  30 ) 

CALL  MOVE ( SK (  1*  7 ) * SKQSS ( 2 5  *  19 )  *  6  *  6  *  1 3  *  30 ) 
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C  4TH 
150 


300 


310 

320 


330 


340 


350 


2  CO 


1) * SKQSS (13(25) *6*6*18*30) 
1) .SKQSS I  19*25) *6*6*18*30) 


CALL  MOVE ( SK ( 1 3  * 

CALL  MOVE ( SK (  7* 

GO  TO  300 

SUBDIVIDED  PLATE  OF  QUADRILATERAL 
CALL  MOVE (SK( 13*13) .SKQSS I  1»  11*6*6*18*30) 
CALL  MOVEISKI  7  ♦  1 3 ) * SKQSS l 1 3  *  1 }  *  6  *  6  *  18 * 30 ) 
CALL  MOVEISKI  1  *  13  )  *SKQSS ( 25 #  1 )  *  6  *  6  *  1 8 » 30 ) 
CALL  MOVE ( SK ( 1 3  *  7).SKQSS(  1 » 1 3 ) *  6  *  6  *  18  *  30 ) 
CALL  MOVEISKI  7*  7  )  * SKQSS l 1 3  *  1 3 ) *  6  *  6 . 18  *  30 ) 
CALL  MOVEISKI  1*  7 > * SKQSS I  2 5  *  1 3 ) *  6  *  6  *  18  *  30 ) 
CALL  MOVE! SK ( 13  *  1)*SKQSS<  1  *  25 ) *  6  *  6  *  18 » 30 ) 
CALL  MOVEISKI  7*  1 ) * SKQSS I  1 3  * 25 ) » 6  *  6  *  18  *  30 ) 
TO  200 


IF! IBUC.EQ.OJGO 


SKI  6#  6 ) =SK  I  6*  6 ) +SKPRE  1 1  ) 

SK I  1 2 •  6 ) =SK 1 12  *  6 ) +SKPRE  l  2  ) 

SKI  12*12 )=SK( 12  #12)+SKPRE<3  ) 

SKI18*  6 ) =SK ( 18  *  6 ) +SKPRE I  4 ) 

SK(18.12)*SK( 18.12)+SKPRE<5  ) 

SK 118*18) =SK I  18*18) +SKPRE  I  6  ) 

SK ( 6  *  1 2 )  =  SKI  12*6) 

SK I  6  *  1 8 )  =  SK (18*6) 

SKI  12*18)  =  SK I  1 8  *  1 2  > 

I F ( N4»  NE • 0 ) GO  TO  310 

CALL  MOVE! SKI  1*1) »SKQ(1»1) *18*18*18*30) 

GO  TO  200 

CALL  MOVE  I SK (1*1)*SKQ (25*251*6*6*18*30) 

GO  TO! 320*330*340*350 ) *NQUA 

CALL  MOVE  I  SKI  7 *7) *SKQ(1*1) *12*12*18.30) 

CALL  MOVE! SKI  1*7) *SKQ (25*1) *6*12*18*30) 

CALL  MOVE  I SK (7*1) *SKQ(1  *25)  *12  *6*18*30) 

RETURN 

CALL  MOVE l SKI  7 *7) >SKQ(7*7) *6*6*13.30) 

CALL  MOVEISKI 13. 7 )*SKQ I  19 *7 1*6*6*18*30) 
CALL  MOVEISKI 1*7) *SKQ(25*7) *6*6*18*30) 
CALL  MOVEISKI 7*13) *SKQ(7.19) *6*6*18*30) 
CALL  MOVE  I  SKI  13 *13) *SKQ(19.19) *6.6*18*30) 
CALL  MOVE! SKI  1*13) *SKQ(25  *19) .6*6  *18  *30) 
CALL  MOVE  I  SKI  7.1 ) *SKQ (7  *25)  *6*6*  18*30) 
CALL  MOV E I SK (13*1) .SKQI 19*251*6*6*18*30) 
RETURN 

CALL  MOVEISKI 13 *13) *SKQ( 13*13) *6*6*18*30) 
CALL  MOVE  I SK ( 7  *  13 ) *SKQ (19*131*6*6*18*30) 
CALL  MOV El  SKI  1.13) *SKQ (25*13) *6*6*18*30) 
CALL  MOVE (SKI  13.7) »SKQ( 13*19 ) *6*6*18*30) 
CALL  MOVE! SKI  7 *7) *SKQ (19*19) *6.6*18*30) 
CALL  MOVE  I  SKI  1.7) .SKQI 25 *19  ) *6*6  *18  *30) 
CALL  MOVEISKI 13*1 ) .SKQI 13*25) *6*6*18*30) 
CALL  MOVE  I  SKI  7*1) .SKQI 19 *25) *6.6.18*30) 
RETURN 

CALL  MOVE  I  SKI  13. 13) .SKQI 1*1) *6*6*18*30) 
CALL  MOVE! SKI  7 *13) .SKQI 13*1) *6*6.18*30) 
CALL  MOV E I SK 11*13) .SKQI 25*1 ) *6*6  *18  *30) 
CALL  MOVE l SKI  13 *7). SKQI 1*13) *6*6*18*30) 
CALL  MOVE (SKI  7 *7) .SKQI 13 *13) *6.6*18.30) 
CALL  MOVE  I  SKI  1*7) *SKQ (25*  13)  *6*6*18*30) 
CALL  MOVE  I SK (13*1) *SKQ (1*25)*6.6.18*30) 
CALL  MOVE  I SK 1 7  *  1 ) * SKQI  13. 25)  *6  *6*18  *30) 
RETURN 
END 


1741 


1704 

1705 

1706 

1712 

1713 

1714 

1715 

1719 

1720 

1721 

1722 

1723 

1724 

1725 

1726 

1727 

1731 

1732 

1733 

1734 

1735 

1736 

1737 

1738 

1739 

1743 

1744 

1745 

1746 

1747 

1748 

1749 

1750 

1751 

1752 
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SUBROUTINE  MOVE 


IBFTC  MOVE*  DECK 

SUBROUTINE  M0VE(A#B*N1#N2*N3.N4) 

1755 

1756 

ADD 

ELEMENTS  OF  A  TO  B  AND  STORE  IN  B 

1757 

1758 

DIMENSION  AIN3*1> #B(N4»1> 

1759 

1760 

DO  10  J«1*N2 

1761 

DO  10  I ■ 1 *N1 

1762 

10 

B(I.J)»B(I*J)fA(  ItJ) 

1763 

RETURN 

1764 

END 

1765 
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SUBROUTINE  PMTR 


S 1 BPTC  PMTR*  DECK 

SUBROUTINE  PMTR 

COORDINATE  TRANSFORMATION  MATRIX  FOR  TRIANGULAR  PLATE  AND  QUADRILATERA 


COMMON /PMTR 1/PT 
COMMON /PST  I F9/NP.N4 

COMMON/PST IFG/XS1*YS1*ZS1.XS2#YS2.ZS2.XS3.YS3.ZS3.XS4.YS4.ZS4 


****  DEFINITION  OF  ARGUMENTS  **** 

XS1 # YS1 *ZS1  -  STRUCTURAL  COORDINATES  AT  NODE  1 

FOR  TRIANGULAR  AND  QUADRILATERAL  PLATE 
XS2  *  YS2 *  ZS2  -  STRUCTURAL  COORDINATES  AT  NODE  2 

FOR  TRIANGULAR  AND  QUADRILATERAL  PLATE 
XS3 * YS3 •  ZS3  -  STRUCTURAL  COORDINATES  AT  NODE  3 

FOR  TRIANGULAR  AND  QUADRILATERAL  PLATE 
XS4 *  YS4 *  ZS4  -  STRUCTURAL  COORDINATES  AT  NODE  4  FOR  QUADRILATERAL  PLAT 
PT  -  TRANSFORMATION  MATRIX  IN  PARTITION  FORM  FOR 
TRIANGULAR  OR  QUADRILATERAL  PLATE 

DIMENSION  PT(3*3)#XX(3)*YY(3)*ZZ(3) *D(3) 

THE  FOLLOWING  PROJECTIONS  (LENGTHS)  ARE  USED  TO  COMPUTE 
DISTANCES  BETWEEN  NODES. 

XX(1)  •  XS2-XS1 
YY ( 1 )  -  YS2-YS1 
ZZ(1)  ■  ZS2-ZS1 

I F ( N4 *NE .0 ) GO  TO  1 
XX ( 2 )  -  XS3-XS1 
XX ( 3 )  «  XS3-XS2 
YY ( 2 )  *  YS3-YS1 
Y Y ( 3 )  -  YS3-YS2 
ZZ ( 2 )  -  ZS3-ZS1 
ZZ ( 3 )  ■  ZS3-ZS2 
GO  TO  4 

1  XA  -  ( XS4+XS3 1/2.0 
YA  »  ( YS4+YS3 ) /2.0 
ZA  =*  ( ZS4+ZS3  1/2.0 
XX ( 2 )  ■  XA-XS1 
YY ( 2 )  -  YA-YS1 
ZZ ( 2 )  ■  ZA-ZS1 

D(l)  IS  L21 *  ETC.  WHERE  L21  IS  DISTANCE  BETWEEN  NODES  1  AND  2*ETC. 

4  DO  10  1-1*3 

I F ( N4 • EQ • 0 ) GO  TO  6 
I F ( I • EQ. 3 )  GO  TO  20 

8  D(I)  -  SORT ( XX ( I ) **2  +  YY(I)**2  +  ZZ(I)**2) 

10  CONTINUE 

FORM  UPPER  LEFT  PARTITION  OF  PT.  (SHOWN  ABOVE t 


1834 

1835 

1836 

1837 

1838 

1839 

1840 
18^1 
18^2 

1843 

1844 

1845 

1846 

1847 

1848 

1849 

1850 

1851 

1852 

1853 

1854 

1855 
1866 
1868 

1869 

1870 

1871 

1872 

1873 

1874 

1875 

1876 

1877 

1878 

1879 

1880 
1881 
1882 

1883 

1884 

1885 

1886 

1887 

1888 

1889 

1890 

1891 

1892 

1893 

1894 

1895 

1896 

1897 

1898 

1899 

1900 
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ctr*r>  ci  ci  n  ci  nonnnnnn 


***************************************************  1901 

1902 

PTdtll  IS  LI*  PT  ( 1  *2  >  IS  L2»  PT  (  1  •  3  )  IS  L3  1903 

PT ( 2  *  1 )  IS  Ml*  PTI2.2)  IS  M2*  PT(2*3)  IS  M3  1904 

PT ( 3  *1 )  IS  Nl*  PT ( 3  *2 )  IS  N2.  PTI3*3)  IS  N3  1905 

1906 

♦I*************************************************  1907 

1906 

20  P T ( 1  *  1 )  =  XX ( 1 ) /D ( 1 )  1909 

PT  <  2  ♦  1  )  =  YY ( 1  I /0  < 1 1  1910 

PT  (  3  *  1  )  -  ZZm/D<l)  19H 

1912 

DD  IS  ( L 31  X  L32 )  1913 

1914 

I  F ( N4  4  NE • 0 ) GO  TO  40  1915 

DD  «  D ( 2 ) *D ( 3 )  1916 

DL3  = ( YY ( 2 ) *ZZ ( 3 )  -  YY < 3 > *ZZ < 2 ) > /DD  1917 

DM3  » ( XX ( 2 ) *ZZ ( 3  )  -  XX < 3 ) *ZZ ( 2 ) ) /DD  1918 

DN3  * ( XX  <  2 ) *YY ( 3  )  -  XX ( 3 ) *YY ( 2 ) » /DD  1919 

GO  TO  50  1920 

40  DL3  =  ( PT ( 2  *  1 ) *ZZ ( 2 )  -  PT l 3* 1 ) *YY< 2 )) /D( 2 )  1921 

DM3  * ( PT ( 1  *  1 ) *ZZ ( 2 )  -  PT(3*1)»XXC2) )/D(2)  1922 

DN3  ■(PT(1»1)*YY(2)  -  PT ( 2  *  1 ) *XX ( 2 ) » /D ( 2 )  1923 

50  SOD-SORT<DL3**2+DM3**2fDN3**2)  1924 

PT( 1  *  3 )  *  DL3/SOD  1925 

PT ( 2  *  3 )  -  -  DM3/SQD  i926 

PT ( 3  *  3 )  ■  DM  3/SOD  1927 

1928 

PT ( 1 *2 )  ■  PT ( 2  *  3 ) *PT ( 3  *  1 )  -  PT ( 2  *  1 ) *PT ( 3 • 3 )  1929 

PT ( 2  *2 )  ■  PT ( 1  *  1 ) *PT (3*3)  -  PT < 3  *  1 ) *PT ( 1 *3 >  1930 

PT ( 3  *2 )  -  PT ( 2  1 1 ) *PT (1*3)  -  PT 1 1 *1 ) *PT ( 2 .3 >  1931 

1935 

*********#*****#*#«*****4*************************  1936 

1937 

RETURN  19*2 

END  1’63 
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SUBROUTINE  SMTR 


S IBFT C  SMTR*  DECK 

SUBROUTINE  SMTR  1957 

COMMON  /PSTIF9/  NP*N4  1958 

COMMON  /PSTIFH/  XL1 » YLI |XL2 # YL2 #XL3 • YL3 #XL4 , YL4  1959 

COMMON/STRAN/GQUAD ( 8  »24 )  i960 

DIMENSION  X  ( 4 ) » Y(  4 ) #X| (4) *YI (4) *NR ( 4 ) *NU ( 4 )  1961 

DIMENSION  2(16)  1962 

X(1)«XL1  1963 

X ( 2 ) =  XL2  1964 

X ( 3 ) «XL3  1965 

XUI-XL4  1966 

YUl-YLl  1967 

Y ( 2 ) *YL2  1968 

Y ( 3 ) *YL3  1969 

Y ( 4 1 =  YL4  197o 

DO  3  I  >1*8  1971 

DO  1  J*  1  *  24  1972 

1  GOUADI I *J)-0.0  1973 

3  CONTINUE  1974 

IF(N4»LE»0) GO  TO  4  1975 

XB>340*(X(4)*Y(3)-X(3)*Y(4)+X(2)*Y(4) )  1976 

XG»(X(4)+X(3) )/3.0+(X(2)*Y(4)*(X(2)-X(3) ) )/XB  1977 

YG*(Y(4)+Y<3) )/3.0-X<2)*Y(4)*Y(3)/XB  1978 

I F  <  X ( 2 ) .EQ.X(4) )GO  TO  35  1979 

YI  (2)*Y(4)*(XG-X<2>  )  /  ( X  (  4 ) -X  (  2  )  )  I960 

GO  TO  36  1981 

35  YI(2)=1.0E  20  1982 

36  IF(X(4).E0.X(3) )GO  TO  37  1983 

Y I { 3 ) *  <  Y  <  4 ) -Y  <  3 )) # ( XG-X  <  3 )) / ( X  <  4 ) -X  <  3 ) >  + Y  <  3 )  I984 

GO  TO  38  1985 

37  YI(3)-1.0E+20  I986 

38  IF(X(3),EQ.O.)GO  TO  39  1987 

YI(4)=Y(3)*XG/X(3)  1988 

GO  TO  40  1989 

39  Y I ( 4 ) *  1 . 0E  +  20  1990 

40  NT=4  1991 

GO  TO  5  1992 

4  XG=(X<2)+X<3) )/3,0  1993 

YG*Y ( 3 ) / 3*0  1994 

IF(X(2).EO.X(3))GO  TO  45  1995 

YI(2)*Y(3)*( XG-X (2) ) / (X ( 3 )-X ( 2  ) )  1996 

GO  TO  46  1997 

45  YI(2)*1.0E  21  1998 

46  I F ( X ( 3 ) , EQ« 0, ) GO  TO  47  1999 

YI(3)*Y(3)*XG/X(3)  2000 

GO  TO  48  2001 

47  Y I  (  3 ) “ 1 «  0E  +  20  2002 

48  NT*3  2003 

5  CONTINUE  2004 

YT-1.0E  20  2005 

YB«0  2006 

DO  8  1*2  *NT  2007 

IF(YI(I)*GT,YG)GO  TO  6  2008 

I F ( Y I ( I ) * LE • YB ) GO  TO  8  2009 

YB* Y I ( I)  2010 

GO  TO  8  20H 

6  IF(YI(I).GT.YT)GO  TO  8  2012 
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YT= Y I ( I )  2013 

8  CONTINUE  20U 

WY=YT-YB  2015 

YC=(YT+YB)/2.0  2016 

EIY=(WY**3)/12*0  2017 

ELY=YC-YG  2018 

JR  =  0  2019 

DO  10  I =1 *NT  2020 

I F ( X ( I ) • LE«  XG ) GO  TO  10  2021 

JR=JR+1  2022 

NR ( JR ) = I  2023 

10  CONTINUE  2024 

IFIN4.GT .0  ICO  TO  11  2025 

XL=X ( 3 ) * YG/Y ( 3 )  2026 

XR=(X(3)-X(2) )*YG/Y(3)+X<2)  2027 

GO  TO  15  2028 

11  XI ( 1 ) = ( XI41-XI 2 ) )*YG/Y<4>+X<2)  2029 

IF(Y(3).EQ.Y(4) ) GO  TO  110  2030 

X  I  (  2  )  =  (  YG-Y  (  3  >  )*(X(4)“X(3)  )  /  (Y(4)-Y(3)  )  4-X  (  3  )  2031 

GO  TO  111  2032 

110  XI (2)=1.0E  21  2033 

111  XI ( 3 ) =X ( 3 )*YG/Y ( 3 )  2034 

XR  = 1 • OE  20  2035 

XL=-1.0E  20  2036 

DO  14  1=1*3  2037 

IF(XI  (  I  )  .GT.XG-IGO  TO  12  2038 

IFtXI ( I ) .LE.XL1GO  TO  14  2039 

XL=X I ( I )  2040 

GO  TO  14  2041 

12  I F ( X  I ( I ) *GE  *  XR ) GO  TO  14  20^2 

XR=X 1(1)  2043 

14  CONTINUE  2044 

15  CONTINUE  2045 

WX=XR-XL  2°46 

XC= ( XR+XL ) /2 • 0  2047 

EIX=(WX**3)/12.0  2048 

ELX=XG“XC  2049 

JT=0  2050 

DO  16  I  =  3  *  NT  2051 

I F ( Y 1  I ) • LE • YG ) GO  TO  16  2052 

JT=JT+1  2053 

NU I J  T )  =  I  2054 

16  CONTINUE  2055 

DO  17  J  =  1  *  JR  2056 

K=(NR< J)-l)*6+3  2057 

N J  =  N R ( J  )  2058 

GQUADI 1 *IO  =ELY/EIY  2059 

GOUAD ( 1 *K+1 )=-( Y(NJ ) -YC ) *EL Y/E I Y+l . 0/WY  2060 

GQUADI  1*K.+2)  =  (X(NJ)-XG)*ELY/EIY  2061 

K=(NR( J ) — 1 1*6+5  2062 

GQUAD(3*U«1.0/WY  2063 

K= ( NR ( J ) “1 ) *6+6  2064 

GQUAD(4.K)=-1.0/WY  2065 

K=(NR( J)-l)*6+2  2066 

GQUAD(7*K)=-1.0/WY  2067 

G0UAD(7*K+4)=(X(NJ)-XG)/WY  2068 

17  CONTINUE  2069 

DO  18  J=1 *JT  2070 

K=(NU( J)-l)*6+3  2071 

N J=NU I J )  2072 
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GQUAD(2iK)=ELX/EIX 
GQUAD ( 2  t  K+l ) =— ( Y  < NJ  ) -YG ) *ELX/E I X 
GQUAD  <  2  #  K+2 ) *  <  X  <  N J ) -XC ) »ELX/EI X+l »0/WX 
K=(NU< J)-l)*6+6 
GQUAD (  5»X)=*“1»0/WX 
K= ( MU ( J ) “1 ) *6+ 1 
GQUAD (6*K)*1»0/WX 
GQUAD ( 6  *K+5 ) « ( Y ( NJ ) -YG ) /WX 
X=(NU(J)“l)*6+2 
GQUAD ( 8 • K ) *1 • O/WX 
GQUAD ( 8  *  K+4 )  —  ( X ( N J ) -XG ) /WX 
18  CONTINUE 
30  RETURN 
END 


2073 

2074 

2075 

2076 

2077 

2078 

2079 
2000 
2081 
2082 

2083 

2084 

2085 

2086 
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SUBROUTINE  LOCAL 


SI6FTC  LOCAL*  DECK 

SUBROUTINE  LOCAL  2089 

C  2090 

C  FORM  LOCAL  COORDINATES  from  STRUCTURAL  COORDINATES  2091 

C  FOR  TRIANGULAR  OR  QUADRILATERAL  PLATE  2092 

C  2093 

COMMON/RENT/NRENT  »KRENT  2094 

COMMON/PST IF9/NP*N4  2095 

COMMON /PST  I FG/XS1 * YS 1 *Z S 1  .XS2 • YS2 . ZS2 * XS3 . YS3 . ZS3 • XS4 . YS4 * ZS4  2096 

COMMON /P ST IFH/XL1*YL1*XL2*YL2*XL3*YL3*XL4»YL4  2097 

COMMON /P  ST  I FL/ I  SWAP  2098 

COMMON /TAPES/MTl ,MT2 * MT 3 »MT4 *M T5 »MT6 *MT7 *MT8 *MT 9 *M T 10 »MT 1 1 *MT12. 

*  MT13*MT14*MT15*MT16*MT17 

C  2102 

D(D1»D2»D3*D4*D5«D6)*(D1-D2)**2-MD3-D4>**2+(D5-D6 1**2  2103 

C  2104 

C  GENERATION  OF  LOCAL  COORDINATES  FOR  FIRST  THREE  NODES  IS  the  2105 

C  SAME  FOR  TRIANGULAR  AND  QUADRILATERAL  PLATES  2106 

C  2107 

C  D21  IS  THE  DISTANCE  SQUARED  BETWEEN  NODES  2  AND  1  FOUND  FROM  2108 

C  STRUCTURAL  COORDINATES*  ETC.  2109 

C  2110 

I  OUT  =  MT6 

D21  =  D(XS2*XS1*YS2*YS1*ZS2*ZS1)  21U 

D31  =  D(XS3*XS1*YS3*YS1*ZS3*ZS1)  2H2 

D32  =  D(XS3*XS2*YS3*YS2*ZS3*ZS2)  2113 

1  SWAP  -0  2  i  1 4 

KRENT  *0  2U5 

C  2116 

C  NODE  1  2117 

C  2118 

XL1-0.0  2119 

YLl-0.0  2120 

C  2121 

C  NODE  2  2122 

C  2123 

XL2=SQRT (D21 )  2124 

YL2-0.0  2125 

C  2126 

C  NODE  3  2127 

C  2128 

XL3= ( D31-D32+D21 ) / ( 2.0*XL2)  2129 

YL3=SQRT(D31-XL3**2)  2130 

C  2131 

C  NODE  4  2132 

C  2133 

IF(N4.EQ.O) GO  TO  50  2134 

40  D41  =  D( XS4*XS1 »YS4*YS1 * ZS4  * ZS 1 )  2135 

D42  =  D1XS4.XS2 *YS4*YS2 *ZS4*ZS2)  2136 

D43=D(XS4*XS3*YS4*YS3*ZS4.ZS3)  2137 

XL4=(D41-D42+D21)/(2.0*XL2)  2138 

YL4=SQRT ( D4 1-XL 4**2 )  2139 

D43L=  < (XL4-XL3)**2+(YL4-YL3)**2)  2140 

IF(ABS(D43“D43L).GE».10*D43)GO  TO  44  2141 

C  2142 

C  CHECK  SEQUENCE  OF  LOCAL  COORDINATES  OF  QUADRILATERAL  PLATE  2143 

C  2144 


r>  n  o  r>  n  r> 


IF  < (XL4«YL3)-(XL3*YL4))  42*4*4 

SWAP  COORDINATES  FOR  NODES  3  AND  4 

42  I  SWAP3 1 
RETURN 

CHECK  FOR  REENTRANT  CORNER 

4  CONTINUE 

X32  ■>  XL3  -  XL2 
X42  =  XL4  -  XL2 

IF  ( (X42*YL3)-(X32*YL4) )  44*50*50 
44  WRITE! I  OUT *1000) NP*XL1 * XL2 ♦ XL3 ,XL4 , YL1 . YL2 . YL3 . YL4 
NRENT  -1 
KRENT  =  1 
50  RETURN 

1000  FORMAT ( 25H  QUADRILATERAL  PLATE  NO.  .14. 

*23H  HAS  A  REENTRANT  CORNER/23HOLOCAL  COORDINATES  ARE./ 
*14HOX-COORDINATES*4!3X*E15.8  > / 14HOY-COORD I  NATES .4 < 3X * E 15 .8 ) > 
END 


2150 

2151 

2152 

2153 

2154 

2155 

2156 

2157 


2163 

2164 

2165 

2166 

2167 

2168 

2169 

2170 
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r>nn  non  non  non  noon  non 


SUBROUTINE  COPLAN 


SIBFTC  COPLA*  DECK 

SUBROUTINE  COPLAN ( NERR )  2173 

2174 

DETERMINE  THE  DEGREE  OF  COPLANARTY  2175 

2176 

COMMON/PST  I F9/NP.N4  2177 

C0MM0N/PSTIFG/XS1.YS1.ZS1.XS2.YS2.ZS2.XS3.YS3.ZS3.XS4.YS4.ZS4  2178 

C0MM0N/PSTIFH/XL1 .  YL 1 . XL 2 » YL2 » XL 3  * YL3 . X L4 » YL4  2179 

COMMON/NOMERG/INER  2180 

COMMON/CHECK/ACPT  *GR0SS  2181 

COMMON /TAPES/MT ltMT2.MT3.MT4.MT5 .MT6.MT7.MT8.MT9.MT10.MT11.MT12. 

*  MT13.MT14.MTl5.MT16.MT17 

2185 

ACPT  -  ACCEPTABLE  PERCENT  OF  NONCOPLANARITY  OF  QUADRILATERAL  PLATE  2186 

GROSS  -  NOT  ACCEPTABLE  PERCENT  OF  NONCOPLANARITY  OF  QUADRILATERAL  PL'AT  2187 

2188 

I  OUT  =  MT6 

NERR=0  2189 

RTD43=SQRT( ( XS4-XS3 ) **2  + < YS4-YS3 ) **2+< ZS4-ZS3 ) **2 )  2190 

PERCT=( 100.0* (RTD43-SQRT! ( XL4-XL3 ) **2+ ( YL4-YL3 ) **2 ) ) )/RTD43  2191 

2192 

TEST  FOR  EXCEPTABLE  ERROR  WITH  NO  COMMENT  2193 

2194 

IF (ABSIPERCT ) .LE.ACPT  )  GO  TO  50  2195 

2196 

TEST  FOR  MINOR  OR  GROSS  ERROR  WITH  COMMENT  2197 

2198 

IF(ABS(PERCT).GE. GROSS)  GO  TO  40  2199 

2200 

MINOR  ERROR  -  CONTINUE  ANALYSIS  2201 

2202 

WRITE! IOUT.IOOOJNP.PERCT  2203 

GO  TO  50  2204 

2205 

GROSS  ERROR  -  DELETE  ANALYSIS  2206 

2207 

40  NERR=1  2208 

INER=1  2209 

WRITE! IOUT* 1001 )NP»PERCT  2210 

50  RETURN  22U 

1000  FORMAT (25H0QUADR I  LATERAL  PLATE  NO.  .14/  2212 

*9X.25HDEGREE  OF  NONCOPLANARITY  .F6.3.8H  PERCENT/  2213 

*9X»31HACCEPTABLE  -  ANALYSIS  CONTINUED)  22U 

1001  FORMAT ( 25H0QUADR I  LATERAL  PLATE  NO.  .14/  2215 

*9X » 25HDEGREE  OF  NONCOPLANARITY  .F8.3.8H  PERCENT/  2216 

*9X . 3 3HNOT  ACCEPTABLE  -  ANALYSIS  DELETED)  2217 

END  2218 
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r»  n  n 


SUBROUTINE  BEAM 


SlBFTC  BEAM*  DECK 

SUBROUTINE  BEAM 
COMMON /T ITL/TITLEI13) 

C 

DIMENSION  XL ( 50 ) •  TEMP ( 50 ) 

DIMENSION  PROP (600) #FLX(6#6> #SKAB(6#6) *6AMX (6(6) *GAM2(6*6) * 

2 AK ( 12*12) »Q  ( 12*12) #BK(12#12) *TLAM ( 12 • 12 ) * GAMMA ( 12  *  12 ) *0G ( 12  #12 ) • 
30FSET  (  6 )  #  JF I  X ( 6  )  #ALAM(6»6) #ALAMA(6#6) #ALAMB(6#6) *ALSL(6*6) » 

4XKG ( 1 2  # 12 ) 

C 

COMMON /C ON T 1/ JPART ( 800 ) 

COMMON/CONT2/KPART ( 800 ) 

COMMON/LASTND/LN ( 200 ) 

COMMON/CORD/XN ( 2000 ) #YN(2000) #ZN(2000) 

COMMON / T ERMS / NB E AM #NP LATE  #NNODE  #NCOND # I PT #NPS  * IUM2 
COMMON/ T APES/MTl»MT2»MT3»MT4#MT5 #MT6  #MT7 #MT8 #MT9 #MT 10 #MT 1 1 »MT12* 
*  MT13»MT14#MT15*MT16#MT17 
C 

COMMON/PROP T/Y I ( 100 >  #ZA ( 100 ) *XA( 100) *Z I ( 100 ) # YA ( 100 ) . GJ < 100 ) 
COMMON/ ADPRO/EM,G#RC» ALFA #DARC#DL 
COMMON /SSTR / EMM »GG 
COMMON /VAR/NPT  S  #FNPTS 
COMMON /N3N3/N3 
COMMON /FLAG/ NF LAG 
C 

EQUIVALENCE(PROP#YI ) 

C 

IN  =  MT  5 
I OUT  =  MT6 
ISTRS  =  MT16 
ISTIF  =  MT2 
NPTS=100 
FNPTS=100.0 
Kl-NPS+1 


1999  CONTINUE 
NB  =  0 
L I NE=0 

WRITE! IOUT  #9011) ( II • 1 1 - 1 1 3  > 


222 

222 


222 

222 

223 

223 

223 

223 

223 

223 


224 

224 

224 

224 

224 

224 

224 

224 

224 

225 


225 

225 

225 

225 

226 
226 
226 
226 


C*****NB  COUNTS  BEAMS 

2001  NB=N3+1  226 

ILOAD'O  227 

C  227 

C******  READ  BEAM  DATA  tJEA 


RC  =  0. 

READ ( IN.9030)KB»N1 #N2#N3# I SP #NSP • IOC # I OFSET • 

1IFRC#(JFIX(K) #  K  =  1 » 6 ) #IBUC#EM»G 
IF( IBUC.NE.O) READ ( IN #9090 )SK»SSK 

I F { ( IBUC.NE.O)  .AND.  (SK  .NE.  0.0))  WR I TE ( IOUT ♦ 935 1 )  SK 
IFMIBUC  .NE.  0)  .AND.  (SSK  .NE.  0.0))  WR  I  TE  (  IOUT  » 93  5 1 )  SSK 
I F  < IFRC.NE.O)  READ (IN#  9090 )  RC 
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o  r>  r> 


227 


DO  16  K  =  1  *6 

16  JFIX|K)=IABSIJFIX(K) ) 
C  ' 


C»****CHECK  RANGE  OF  NODES 


I F ( NNODE-N 1  )  25 . 20  *2 0  227 

20  I F ( NN0DE-N2  >25.30*30  227 

25  WRITE  ( IOUT * 9050 ) KB  227 

NFLAG=1  227 


(;••••••  CHECK  VALIDITY  OF  DATA 


30  I F ( EM ) 35  *40  *  45 

22  8 

35  WRITEl IOUT  *9060 ) KB 

228 

EM=ABS ( EM) 

228 

GO  TO  45 

22  8 

40  EM-EMM 

228 

45  I F ( G  > 50*55.60 

228 

50  WRITEl I  OUT . 9070  >  KB 

228 

G=ABS 1 G ) 

228 

GO  TO  60 

228 

55  G=GG 

228 

60  IFIKB  -NB)54. 70*54 

229 

54  WRITEl IOUT. 9080JKB  *NB 

229 

CALL  EXIT 

229 

229 

OFFSET  NODES 

229 

22  9 

70  IF! IOFSET>56. 57*56 

229 

229 

56  READ  IIN*9090) (0FSETII)*I"1*6) 

229 

229 

GO  TO  59 

230 

57  DO  58  1=1.6 

230 

58  OFSET I  I ) =0.0 

230 

59  M=N1 

230 

X 1=XN I M  )  +QFSET I  1 ) 

230 

Yl=YN(M)+OFSET (2) 

230 

Zl=ZN(M)+OFSET 13) 

230 

XA1  =  ABS I XN I M  )  ) 

230 

YA 1 = ABS 1 YN I M ) ) 

230 

ZA1*ABS<  ZNIM) ) 

230 

M  =  N2 

231 

X2  =  XN I M ) +OFSET I  4 ) 

231 

Y2=YN(M)+OFSETI5) 

231 

Z2=ZN(M)+OFSET<6) 

231 

XA2= A6S I XN I M ) ) 

231 

YA2= ABS I YN 1 M ) ) 

231 

ZA2«ABS<  ZNIM) ) 

231 

M  =  N3 

231 

X3=XN I M ) 

231 

Y3-YNIM) 

231 

Z3-ZNIM) 

232 

232 

•♦•♦COMPUTE  OFFSET  TRANSFORMATION  MATRIX 

C 


IF( IOFSET.NE.O >  CALL  OFSTIOFSET  * GAMMA  *GAM1 *GAM2 ) 


232 

232 
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n  n  o  n  n  n  n  n  n 


CONNECTIVITY  INFO  FOR  BEAM 


MPT=IPT-1 
00  65  I=1*MPT 

I  F ( ( N1 <  LE*LN ( 1  +  1 1 ) (AND* (Nl*GT*LN<I)l)NI*I+l 
I F ( ( N2 • LE»LN ( I +  1 ) I • AND* <N2<GT*LN ( 1 1  I >NJ  = I+l 

*####N 1  IS  IN  THE  NI-TH  PARTITION 
**#**N2  IS  IN  THE  NJ-TH  PARTITION 

IF<N1<LE<LN (1) 1  N  I  ■  1 
I  F<N2<LE<LN< 1 ) )NJ-1 
65  CONTINUE 

I F  <  N I <GE<NJ)NINJ«NI*1000+NJ 
IF<NJ<GT<ND  NINJ-NJ*1000+NI 
NINI = 1001*NI 
NJNJ=1001*NJ 


C 


K11«K1-1 
KC-0 
KC1  =  0 
KC2  =  0 


C*#***K1  COUNTS  PARTITIONS 
C*****FIRST  DIGIT  OF  KPART 
LAST  DIGIT  OF  KPART 


FIRST  BEAM  IN  THE  PARTITION 
LAST  BEAM  IN  THE  PARTITION 


DO  66  1=1 #800 
I F  < JPART <+)*EQ*NINJ)KC«I 
IF(JPART< I )<EQ*NINI ) KC 1 ■ I 
I  F ( JPART ( 1 ) <EQ<NJNJ)KC2"I 
66  CONTINUE 
C 

IF<KC<EQ<01G0  TO  81 


232 

232 

232 

232 

232 

232 

233 
233 


233 

233 

233 

233 

233 

233 

233 

233 

234 
234 
234 
234 
234 
234 
234 


234 

234 

234 

235 
235 
235 
235 


C*»#**UPDATE  KPART 

IF<<PART<KC  ) <EQ<0 )  KPART  <  KC  )«10001*KB 
KPARTUC  )  =  (  KPART  ( KC  ) / 10000 ) # 10000+KB 
GO  TO  82 
81  CONTINUE 

C»****NEW  PARTITION  -  COMPUTE  JPART*  KPART 


JPART  <K1)=NINJ 

KP ART ( K 1  1 ■10001*KB 

K1«K1+1 

82  IF<KC1<EQ<01GO  TO  83 


235 

235 

235 

235 


235 

235 

236 
236 


C*****UPDATE  KPART 

IF<KPART<KC11<EQ<01  KPART  <  KC 1 ) ■ 1000 1*KB 
KPART  <  KC 11 - <  KPART  <  KC 1 > / 10000 1  * 10000  +  KB 
GO  TO  84 
83  CONTINUE 


236 

236 

236 

236 
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KJ  KJ  V 


C###**DON'T  COUNT  PARTITION  AGAIN  IF  ALREADY  COUNTED 


IFtNINJ.EQ.NINI )GO  TO  67  236 

C*****NEW  PARTITION  -  COMPUTE  JPART#  KPART 

JPART ( K 1 ) =NI N I  236 

KPARTIKl  )=10001*KB  236 

Kl-Kl+1  236 

67  CONTINUE  237 

34  I F { KC2  »  EQ. 0 ) GO  TO  85  237 

C*****UPDATE  KPART 

IF(KPART(KC2)»EQ»0)  KPART ( KC2 ) * 1000 1*KB  237 

KPART (KC2)*(KP ART <KC2)/10000)*10000+KB  23  7 

GO  TO  86  237 

85  CONTINUE  237 

C*****DO.N'T  COUNT  PARTITION  AGAIN  IF  ALREADY  COUNTED 

I F ( (NJNJ.EQ.NINI ) .OR. ( N JN J , EQ . N I N J ) ) GO  TO  71  237 


C*****HEW  PARTITION  -  COMPUTE  JPART*  ICPART 


C 


C 

C 


JPART ( K1 ) =N JNJ 

237 

KPART 1 K1  ) = 1000 1*KB 

237 

K 1*K 1+1 

237 

71 

CONTINUE 

238 

86 

CONTINUE 

238 

238 

section  PROPERTIES 

238 

238 

IF! ISPI75.810.75 

238 

75 

NCT*  0 

238 

N  I  =  0 

238 

GO  TOI8O.9O.130)  .ISP 

238 

239 

**##**  UNIFORM  PROPERTIES 

80  READ  <IN.9090)YI(1)*ZA<1).XA(1).ZII1).YA!1).GJ(1)  239 

810  WRITE ( I  OUT. 901 2  > KB • N 1 , N2 * N3 * JFIX.YI < 1 > . ZA 1 1 ) . XA ( 1 ) .Z I < 1 ) , YA ! 1 ) . 

1  GJ!1).EM>G 
LINE=LINE+1 

IFILINE.LT. 50)GO  TO  803 
L  I N  E  =  0 
CALL  PAGHED 

WRITE ( I  OUT. 9011 ) ( II .1 1*1*3) 

803  CONTINUE 

IF( IOFSET.EQ.O )  GO  TO  802 
WRITE! I  OUT .9014) tOFSET  (  I ) .1*1.6) 

LINE*LINE+1 

IFILINE.LT. 50IGO  TO  802 

LINE=0 

CALL  PAGHED 

WRITE! IOUT.9011 X II .11-1.3) 

802  CONTINUE 
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c 


TO  190 


IF(ISP.EQ.O)  GO 

DO  89  1=2*100 
PROP! 1) =YI ( 1 ) 
PROPI I +100 ) =ZA ( 1 ) 
PROP ( I +200 ) =XA ( 1 ) 
PROP ( 1+300) =Z1 ( 1 ) 
PROP ( 1+400 )-YA<l) 
89  PROP ( 1+500 ) =GJ ( 1 ) 
GO  TO  190 
C 


239 

239 

239 

239 

239 

239 

239 

239 

240 
240 


90 


DO  125  I< 
LL= 1 00* I 
KK=LL-99 


ES  VARY  ACCORDING  TO  FORMULA 

•  A 

240 

»  o 

240 

240 

*100*115 

240 

240 

9150INI *K*L*M*N.A.B*C 

240 

95  READ  ( 

WRITE! IOUT *9016) KB *N1*N2*N3»JFIX»NI *K*L*M*N*A*Bi 
LINE=LINE+1 

IF(LINE.LT.50)G0  TO  804 
L  I  NE  =  0 
CALL  PAGHED 

WRITE! IOUT  *901 1 ) t II *11-1*3) 

804  CONTINUE 

I F  <  N I -I ) 126*100*115 
100  A J  =  - * 005 
NCT=NCT+1 
DO  105  J=KK*LL 
A J  =  A J+  *0 1 

PROP! J)=C*( 1*0+A*(AJ1**X) **M* ( 1 • 0+B* ( AJ ) **L ) **N 
105  CONTINUE 

IFtNCT-NSP) 125*110*125 
110  N I  =  7 

GO  TO  125 

115  DO  120  J=KK*LL 
PROP! J)=0»0 
120  CONTINUE 

125  CONTINUE 

GO  TO  190 

126  WRITE  ! IOUT  *9160) NI 
CALL  EXIT 


240 

240 

241 
241 
241 
241 
241 
241 
241 
241 
241 

241 

242 
242 
242 
242 
24  2 
242 
242 
242 


C******  PROPERTIES  VARY  ACCORDING  TO  TABLE 

130  DO  185  K=l*6 
LL=1C0*K 
KK=LL-99 

IF(NI-K) 135.140*175 
C 

135  READ  (IN*9010)NI*LTBL*BL 
C 

IF(NI-K) 126*140*175 

140  READ  < IN.9090) <XL( J> *TEMP( J) *J«1*LTBL) 


242 

242 

243 
243 
243 
243 
243 
243 
243 
243 
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n  r>  r>  ri  n  n  r> 


WRITE! IOUT»9017)KB»N1»N2*N3*JFIX»(XL!J) *TEMP<J) .J-l.LTBL) 
LINE=LINE+1 

IFJLINE.LT. 50)GO  TO  805 
L I NE  =  0 
CALL  PAGHEO 

WRITE! I  OUT# 9011  )  (  II  .  11-1*3) 

805  CONTINUE 


c  243 

DO  141  I*1»LTBL  243 

141  XL! I )=XL< Il/BL  244 

DELT  =-.005  244 

1=2  244 

DO  165  J  =  KK  *LL  244 

DELT  =DELT+«01  244 

145  IF(DELT-XL(I))150#155*160  244 

150  PROP!  J)=TEMP(  I >“< < TEMP ! I )-TEMP ! 1-1 ) ) « ! XL ! IJ-DELT)/  244 

1(XL(  I  I  -XL  <  1-1)1)  244 

GO  TO  165  244 

155  PROP ( J ) =TEMP  < I )  244 

GO  TO  165  24b 

160  1*1+1  24b 

GO  TO  145  24b 

165  CONTINUE  24b 

NCT=NCT+ 1  245 

IF(NCT-NSP)185»170*185  24b 

170  N I *7  245 

GO  TO  185  24b 

175  CONTINUE  24b 

DO  180  L  »KK » LL  245 

180  PROP t  L ) *0.0  246 

185  CONTINUE  246 

c  246 

190  CONTINUE  246 

C  246 

£•••***  COMPUTE  TRANSFORMATION  AND  STIFFNESS  MATRICES 

C  246 

IF(RC)205»200»205  246 

246 

246 

200  CALL  SBMTR(X1»Y1»Z1»X2*Y2.Z2  »X3  * Y3 » 23  » ALAM .TLAM )  246 

CALL  SSTIF(AK) 

GO  TO  206  24? 

247 

205  CALL  CBMTRIX1.Y1.21.X2.Y2.22.X3.Y3.Z3.ALAMA.ALAMB.TLAM)  247 

CALL  CSTIF(AK.FLX.SICAB)  247 

247 

206  CONTINUE  24? 

247 

IF!  IBUC.NE.O)  CALL  SBGS  ( SK  »  SSK.  *DL  .XKG ) 

IF! IBUC.NE.O)  CALL  MAD < AX .XKG ) 


247 

248 

DO  201  1=1.6 
DO  201  L  =  1 .6 
SKAB ( I . L ) =AK ( I . L+6 ) 

201  FLX! I *  L ) * AK ( 1+6. L+6) 

C  246 

591  DO  208  1=1.6 
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non  n  nnn  on  nnnnn  no 


IF(JFIX( I )  •  N  E  •  1  )  GO  TO  208 
M3  I 

IF ( I «GT  *3 ) M* I+3 
CALL  REDUCE(AK.12.M) 

208  CONTINUE 
710  CONTINUE 

IF( IOFSET)210*209*210 

209  CONTINUE 

CALL  MULT (AK*TL AM *0*12 *12 *12 *1*0) 

CALL  MULT(TLAM*Q*BK*12*12*12*2*0) 

GO  TO  211 

210  CONTINUE 

CALL  MULT ( TLAM » GAMMA  »QG  *12*12*12*1*0) 
CALL  MULT(AK.*QG*Q*12. 12*12. 1*0) 

CALL  MULT (QG*Q*BK*12*12*12*2*0) 

211  CONTINUE 

ENGINEERING  SIGN  CONVENTION 
DO  213  I  3 1 » 1 2 
Qlltll-QlUIl 
0(3*1 )3-Q(3*I > 

Q(4.1)— Q(4.l) 

0(8*1)— Q(8*I) 

Q(ll*l>— Q(ll*l  I 
0(12*1 ) >-0(12*1  ) 

213  CONTINUE 


WRITING  STRESS  MATRIX 

WRITE( ISTRS)KB*N1*N2 

WRITE( ISTRS) < (Q( I  * J > • I " 1  *  12 ) * J-l *  12  ) 


WRITING  STIFFNESS  MATRIX 
WRITE! ISTIF)N1*N2 

WRITE(  1ST  IF) ( (BK(J*I ) »J«1*6) *I«1*6)  • 

1((BX(J*I)*J31*6)*I“7*12)*((BX(J*I)*J"7*12)»I>1*6)» 
2 ( ( BK ( J • I ) *J*7*12) *I“7»12) 


I F ( I OC *EQ* 0 ) GO  TO  1950 
C 

WRITE( IOUT  *9320 ) 

CALL  PRINT(TLAM*12*12*1»4HTLAM.1*12) 
WRITE  < IOUT  *9270 ) 

CALL  PRINT (AK*12*12*1 »4HAK  *1*12) 
WRITE  < IOUT  *9310 ) 

CALL  PRINT(Q.12*12*1»4HQ  *1*12) 

WRITE  (IOUT. 9300) 

CALL  PRINT(BK*12*12*1*4H8K  *1*12) 

1950  CONTINUE 


248 

248 

248 

248 

280 

248 

248 

249 
249 
249 
249 
249 
249 
2  9 
249 
249 

249 

250 
250 
250 
250 
250 
250 
250 
250 
250 

250 

251 
251 
251 
251 
251 
251 
251 
251 
251 

251 

252 
252 
252 
252 
252 
252 
252 
252 
252 
281 
281 
281 
281 
281 
281 
281 
281 
281 
281 
282 
282 
282 
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c 

2000  I F ( NBEAM-NB )2002#2002#2Q01 


2002  CONTINUE 
NPS=K1-1 


9010  FORMAT (2I4.4X.E12.4) 

9011  FORMAT (/56X.9HBEAM  DATA// 

1  IX*  5H  BEAM  *  3 ( 5H  NODE  ) * 4X * 6HF I X  I TY ♦ 4X *4H I ( Y ) * 8X * 5HA ( XY ) » 9X ♦ 
21HA*9X*4HI  U  )  *8X*5HA(XIZ)  »  9X  »  1H  J  *  9X  *  6HYG  MOD*6X»6HSH  MOD/ /4X  *  3  I  5/  /  ) 

9012  FORMAT (4I5*4X*6I1*8(1PE12.3) ) 

9013  FORMAT ( 9H  RADIUS  =E14.4) 

9014  FORMAT ( 9H  OFFSETS  6E12*4) 

9016  FORMAT (4I5*4X*6I1*10H  PROPERTY  I1.16H  CONSTANTS  K=I5,3H  L=I5. 

1  3H  M  = I  5  *  3  H  N= I  5  *  3H  A=1PE11»3»3H  B=1PE11.3»3H  C=1PE11.3> 

9017  FORMAT (4I5*4X*6I1*10H  PROPERTY  I1.3(3H  X=E12.4*5H  VAL=E12.4)) 

9030  FORMAT (8I4»4X*I4*6I1*I2*2E12»4) 

9050  FORMAT ( 33H1 I NCORRECT  NODE  NUMBER*  BEAM  NO*  13) 

9060  FORMAT (42H1NEGATIVE  MODULUS  OF  ELASTICITY.  BEAM  NO.  13) 

9070  FORMAT (40H1NEGAT IVE  MODULUS  OF  RIGIDITY*  BEAM  NO.  13) 

9080  FORMAT ( 40H1 I NPUT  NOT  IN  PROPER  SEQUENCE*  BEAM  NO.  13* 

111H  SHOULD  BE  13) 

9090  FORMAT (6E12. 4) 

9150  FORMAT ( 514. 4X* 3E12. 4) 

9160  FORMAT ( 1H117HSECTION  PROPERTY  I1.18HIS  OUT  OF  SEQUEN3E ) 

9170  FORMAT (3I4*5E12.4) 

9190  FORMAT(E12. 4*414) 

9270  FORMAT ( 23H1LOCAL  STIFFNESS  MATRIX) 

9290  FORMAT (29H10FFSET  TRANSFORMATION  MATRIX) 

9300  FORMAT ( 28H1STRUCTURAL  STIFFNESS  MATRIX) 

9310  FORMAT ( 14H1STRESS  MATRIX) 

9320  FORMAT < 2 2H 1 TRANSFORM AT  I  ON  MATRIX) 

9350  FORMAT ( 1H  I4.6E12.4) 

9351  FORMAT (20H0INITIAL  BEAM  THRUST  * F 10. 2  * 5H  LBS.//) 

RETURN 

END 


282 

282 

282 

283 

283 

283 

283 

284 


284 

284 

284 

285 
285 
285 

285 

285 

285 

285 

286 
286 
286 
286 
286 

286 

286 
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SUBROUTINE  TINVR 


SIBFTC  TINVR*  DECK 

SUBROUTINE  TINVR  (ELEM.N* IND) 

DIMENSION  ELEM (6*6) 

CALL  OVERFLUOOOFX) 

GO  TO<99*99>  UOOOFX 

99  CALL  DVCHK  UOOOFX) 

GO  TO( 100*100) UOOOFX 

C  COMPUTE  EQUIVALENT  TRIANGULAR  MATRIX 

100  DO  111  I *1 *N 

IF  ( ELEM ( I » I ) )  107*107*108 

107  IND=-1 

GO  TO  310 

108  ELEM ( I  *  I ) -SORT ( ELEMI I  *  I ) ) 

L  =  1  +  1 

IF  (L-N)  103*103*116 

103  DO  102  J=L*N 

102  ELEM ( J  *  I ) -ELEMI I *J) /ELEMI 1*1) 

CALL  DVCHK  UOOOFX) 

GO  TO  1 107* 106 ) UOOOFX 
106  DO  111  K=L*N 

IF  I ELEM  U *  I ) ) 112*111*112 
112  DO  110  JU.N 

110  ELEMU*J)-ELEMU*J) -ELEMI X* I )*ELEMI J • I ) 

111  CONTINUE 

C  INVERT  TRIANGULAR  MATRIX 

116  M=N-1 

DO  198  J- 1  *M 
L  =  J+1 

DO  198  K-L*N 

198  ELEMI JU)=0.0 
DO  199  I  3 1  *  N 

199  ELEMI I *1 ) -1*0/ ELEM 1 1*1) 

DO  206  I  - 1  *M 

L-I  +  l 

DO  206  J-L  *N 
M=J-1 

DO  204  K-I*M 

204  ELEMI I  * J)  =  ELEM( I  * J ) -ELEM I JU ) *ELEM I  I *K) 

206  ELEMI I *J)=ELEMIJ*J )* ELEMI I»J) 

CALL  OVERFL  UOOOFX  I 

GO  TO  I  200*207 ) UOOOFX 

200  I ND=“2 

GO  TO  310 

C  EXPAND  TRIANGULAR  INVERSE 

207  DO  299  I-2*N 
L  =  I-1 

DO  299  J-l.L 
299  ELEMI I *J)-0»0 
DO  306  I - 1 *N 
DO  3C6  J“ I *N 
E  =  0  •  0 

DO  305  K-J*N 

305  E-E+ELEMI I ♦< )*ELEMI J »X) 

306  ELEM I J  » 1 ) -E 
DO  307  I-2*N 
L*  I  —  l 

DO  307  J-l.L 
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3703 
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3709 
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3731 
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3747 
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307 

ELEM(J»I)-ELEM(I,J) 

3756 

CALL  OVERFL  ('K000FX ) 

3757 

GO  T0(300»308) »KOOOFX 

3758 

300 

lND«-3 

3759 

GO  TO  310 

3760 

308 

IND-+1 

3761 

3X0 

RETURN 

3762 

END 

3763 
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SUBROUTINE  SMULT 


SIBFTC  SMULT*  DECK 

SUBROUTINE  SMULT(A»B»C»Nl*N2tN3)  3766 

C  3767 

DIMENSION  A(N1»N2)»B(N2»N3)*C(N1»N3)  3766 

3769 

C*C-A*B  3770 

WHERE  C  IS  AN  N1*N3  3771 

A  IS  AN  N1*N2  3772 

B  IS  AN  N2*N3  3773 

3774 

DO  100  I-1»N1  3775 

DO  100  J-1*N3  3776 

C ( I t J ) *0«0  3777 

DO  100  K-1#N2  3778 

CU»J)-C(I»J)-AU»K)*B(K*J)  3779 

100  CONTINUE  3780 

c  3781 

RETURN  3782 

END  3783 
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SUBROUTINE  MULT 


S IBFTC  MULT*  DECK 

SUBROUTINE  MULT ( A»B»C»N1 *N2 »N3 .N4 * IM  )  3785 

C  N1.N2.AND  N3  MUST  BE  IN  THEIR  ORDER  AFTER  TRANSPOS I TION  3786 

DIMENSION  A(N1»N2)»BIN2»N3> *C(N1»N3)  3787 

N4«'l».  .NORMAL  3788 

N4*2.»»(A( TRANSPOSE ) I *B  3789 

3790 

C=C*A*B  3791 

WHERE  C  IS  AN  N1*N3  3792 

A  IS  AN  NI*N2  3793 

B  IS  AN  N2*N3  3794 

3795 

IM»0  NORMAL  3796 

=1  MOVE  C  TO  B  3797 

3798 

GO  TO ( 1 • 2 ) #N4  3799 

c  3800 

2  CONTINUE  38°1 

DO  10  I»1*N1  3e°2 

DO  10  J-liN3  3803 

C(I.J)-0.0  3804 

DO  10  K=1*N2  3805 

C(I.J)«CII.J)*A(K#II*BCi;»J)  3808 

10  CONTINUE  3807 

GO  TO  98  3808 

1  CONTINUE  3809 

DO  100  I«1»N1  3810 

DO  100  J-1»N3  38ll 

C(I*J)«0.0  3812 

DO  100  IC«1*N2  3813 

C(  I*  J)«C(I.J)*A(  I»K)*  BIKiJI  38U 

100  CONTINUE  3815 

98  CONTINUE  3816 

I F ( IM ) 300*200*300  3817 

200  RETURN  3818 

300  DO  320  I  *  1 #N1  3819 

DO  320  J«1*N3  3820 

B(I»J)-C(ItJ)  3821 

320  CONTINUE  3822 

GO  TO  200  3823 

END  3824 
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SUBROUTINE  SBMTR 


JIBFTC  SBMTR»  DECK 

SUBROUTINE  SBMTR i X I » Y I .ZI .XF »YF»ZF.XC.YC.ZC.ALAM.*LAM) 

STRAIGHT  BEAM  TRANSFORMATION  MATRIX 
DIMENSION  A LAM (6*6) * SL AMI  12*12) 

COMMON /T  APES/MT 1»MT2*MT3»MT4»MT5  »MT6  »MT7  »MT8  »MT9 »MT10»MTll »MT12  * 
*  MT13*MT14»MTlff#MT16.MT17 
COMMON/VAR/NPTS»FNPTS 
COMMON / ADPRO/EM  »G»RC  » ALFA »DARC#DL 
COMMON/N3N3/N3 
C 

XF I =  XF-X  I 
YFI=YF-YI 
ZFI=ZF-ZI 

DS=SORT (XFI •*2+YF I **2 ) 

DL=SQRT!XFI»*2+YFl**2+ZFI**2> 

DARC=DL/FNPTS 

C 

I  OUT  «  MT 6 
IF(N3»EQ»0 )GO  TO  5 
XCI-XC-XI 
YCI *YC“Y I 
ZCI*ZC-ZI 

F«!XCl*XFI+YCI*YFI)/DS 
B=-!XCI*YFl-YCI*XFI »/OS 
D«=!-F*ZFI+ZCI*DS)/DL 
D1V«=S0RT!D*D+B*B) 

D I VR  =  SQRT ( XCI **2+YC 1**2 ) 

5  CONTINUE 
C 

DO  10  I-l»6 
DO  10  J«l»6 
10  ALAM ( I |J)»0.0 
C 

DO  15  1-1*12 
DO  15  J-l*12 
15  SLAM ( I • J ) *0*0 
C 

I F ! DS ) 20  #40  »60 
C 

20  WRITE! IOUT,9000)XI.YI.ZI.XF.YF.ZF 
9000  FORMAT ! 19H1LENGTH  IS  NEGATIVE///! BE  10*3 ) I 
C 

40  CONTINUE 

I F ( N3  *NE  *0 ) GO  TO  41 
S I NB-0 • 

CCSB-1. 

GO  TO  42 

41  SINB-YCI/DIVR 
COSB=XCI/DIVR 

42  ALAM! 1*3)"ZFI/0L 
ALAM(2»1)«SINB*IZFI/DL) 

AL AM !  2  » 2  )  —COSB*  ( ZF I  /DL  ) 

ALAM ! 3  » 1 ) »COSB 
ALAM(3»2)*SINB 
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GO  TO  65 

3366 

3367 

60 

CONTINUE 

3368 

IF ( N3*NE*0 )  GO  TO  61 

3369 

S INB*0 • 

3370 

COSB* 1  • 

3371 

GO  TO  62 

3372 

61 

COSB=D/DI V 

3373 

S I  NB'B/DI V 

3374 

62 

ALAM|1#1)*XFI/DL 

3375 

ALAM(1#2)»YFI/DL 

3376 

ALAMI 1«3)*ZFI/DL 

3377 

ALAM<2*1»— C0SB*IYFI/DS)+SINB*C2FI/DL)*(XFI/DS) 

3378 

ALAM<2.2>-C0SB*IXFI/DS)+SINB*IZFI/DL)*<YFI/0SJ 

3379 

ALAM (2*3) «“SINB* 1 DS/DL ) 

3380 

ALAM(3*1)«-SINB*(YFI/DS)-C0SB*IZFI/DU*(XFI/D5) 

3381 

ALAMt3*2)-SINB»IXFI/DS»-COSB*CZFI/DU*CYFI/DS) 

3382 

ALAM ( 3  *3 ) *COSB* ( DS/DL | 

3383 

3384 

65 

CONTINUE 

3385 

3386 

DO  90  1*1*3 

3387 

DO  90  J-l*3 

3388 

ALAMI 1  +  3  » J+3 ) “ALAM ( I  »  J ) 

3389 

90 

CONTINUE 

3390 

3391 

DO  110  1*1*6 

3392 

DO  110  J-l*6 

3393 

SLAMt I  * JI-ALAMI I *J) 

3394 

SLAMI I+6*J+6)*ALAM( I  * J) 

3395 

110 

CONTINUE 

3396 

3397 

RETURN 

3398 

END 

3399 
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SUBROUTINE  SSTIF 


SIBFTC  SSTIF*  DECK 

SUBROUTINE  SSTIF! AK) 

STRAIGHT  BEAM  STIFFNESS 


3067 

3068 

3069 


DIMENS I ONAK (12*12) 

COMMON/VAR/NPTS.FNPTS 

COMMON/ ADPRO/EM.G.RC .ALFA  »DARC »DL 

COMMON/PROP T/Y I ( 100) .ZA ( 100 ) »XA 1 100 ) .ZI <100 ) # YA < 100 > .GJ ( 100 ) 


YSUM1-0.0 
YSUM2-0.0 
YSUM3-0.0 
YSUM4-0.0 
ZSUM1-0.0 
ZSUM2-0.0 
ZSUM3-0.0 
ZSUM4-0.0 
SUM5-0.0 
SUM6-0.0 
A-0.0 
B-201.0 
C— 1.0 
S-DL 
C 

DO  100  1-1.12 
DO  100  J-l.I 
100  AK ( I . J ) -0.0 
C 

DO  200  I-l.NPTS 
A-AF1.0 
B-B-2.0 
C-C+2.0 

YSUM1-YSUM1+B**2/ZI < 1 » 
YSUM2-YSUM2*1.0/YA< I  I 
YSUM3«YSUM3«-C**2/ZI ( I ) 
YSUM4-YSUM4+C*B/ZI < I ) 
ZSUM1-ZSUM1+B*»2/YI ( 1 1 
ZSUM2-ZSUM2+1.0/ZA! I ) 
ZSUM3«ZSUM3+C**2/YI < I J 
ZSUM4-ZSUM4*C*B/YI C I > 
SUM5-SUM5+1 .0/XA( I ) 
SUM6-SUM6+1.0/GJI I t 
200  CONTINUE 
C 

PARTC2-YSUM2/ ( G*S*FNPTS ) 

B-S/ ( EM* ( 4 .0*FNPTS**3 )  I 

PARTC1-B*ZSUM1 

Cl  -  PARTC1  *  PARTC2 

C2-B*ZSUM3+PARTC2 

C3-B*ZSUM4-PARTC2 

C4  -  C1*C2  -  C3**2 

AK (2.2) -C2/C4 

AK (8.2) -C3/C4 

AK (8.8) -C 1/C4 


3071 

3075 

3076 

3077 

3078 

3079 

3080 

3081 

3082 

3083 

3084 

3085 

3086 

3087 

3088 

3089 

3090 

3091 

3092 

3093 

3094 

3095 

3096 

3097 

3098 

3099 

3100 

3101 

3102 

3103 

3104 

3105 

3106 

3107 

3108 

3109 

3110 

3111 

3112 

3113 

3114 

3115 

3116 

3117 

3118 
3H9 

3120 

3121 

3122 

3123 

3124 


329 
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AM6*6)»<AM2t2K2.0*AM8*2)-*-AM8*8)  )/S**2 

3125 

AM4*4)=FNPTS*EM/IS*SUM5) 

3126 

B=S/(EM*(4,0*FNPTS»»3)  1 

3127 

PARTC1«B*YSUM1 

3128 

PARTC2-Z5UM2/(G*S*FNPTS) 

3129 

C1-PARTC1+PARTC2 

3130 

C2-B*YSUM3+PARTC2 

3131 

C3-B*YSUM4-PARTC2 

3132 

C4-C1*C2-C3»*2 

3133 

AM  3  #  3  )  -C2/C4 

3134 

3135 

AM9*3  I-C3/C4 

3136 

AM9#9)«C1/C4 

3137 

AM12»2)-(AM2*2)+AM8*2)  )/S 

3138 

AM9»5)«<AK(9*3  )+AK  (  9#9  >  )  /S 

3139 

AMltl)«FNPTS*G/<S*SUM6) 

3140 

AM5*5)  =  (AM3t3>  +  2.0*AM9*3)+AM9*9>  )/S**2 

3141 

AM  8  *6)  —  <AM8*2)fAM8#8)  t/S 

3142 

AIC(  11*9)  »“<AM  9*3  >*AM  9*9)  > /S 

3143 

AM  12  *  8  I  *  I  AM  8  *  2 )  +AM  8  »  8  )  )/S 

3144 

AM7tl)“AKIlill 

3145 

AK(10»4)»-AM4#4) 

3146 

AMU*5)»- AM5»5) 

3147 

AM  12  *6)—  AIM  6  *6) 

3148 

AM6*2)»-  AM12#2) 

3149 

AM  5 » 3  )  ■  ( AK  (  3 »  3  )+AM  9  #3  > )  /  S 

3130 

AMU*3>— AM5*3) 

3131 

AKI7.7l-AMl.il 

3132 

AM10*10)«AM4#4) 

3133 

AM  11  *11 ) -AM 3*5) 

3134 

AM12»12)-AM6*6) 

3155 

3156 

DO  300  1-1*11 

3157 

IDIAG-1+1 

DO  300  J- IDI AG *12 

3138 

AIM  1  .JI-AKU.I ) 

3139 

3160 

3166 

3167 

RETURN 

END 

3168 
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SUBROUTINE  MAD 


SlBFTC  MAO*  DECK 

SUBROUTINE  MAD(A*B! 
DIMENSION  A ( 144 ) *B ( 144 1 
DO  10  1-1*144 
A(I»-A(I)+Bm 
10  CONTINUE 
RETURN 
END 
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SUBROUTINE  SBGS 


SIBFTC  SBGS*  DECK 

SUBROUTINE  SBGS I SK* SSK • S *XKG ) 

DIMENSION  XKG (12*12) 

C 

C  ***  COMPUTES  STRAIGHT  BEAM  GEOMETRIC  STIFFNESS  MATRIX-XKG 
C  #*CI_EAR  ARRAY** 

DO  10  1-1*12 
DO  10  J»l*l 
XKG  t I *J)«0.0 
10  CONTINUE 
C 

C  **COMPUTE  ELEMENTS  OF  LOWER  TRIANGLE** 

SK-  -SK 
C 

XKG<6*6)— 1»2/S*SK 
XKGU2*12)-XKG<6*6) 

XKGI12*6)— XKGI6.6) 

XKG< 1 2  * 2 ) *“• 1*5K 
XKGI12#8)-XKG(12*21 
XKGI 6 • 2 ) --XKGI 12  *2 ) 

XKG(8*6)-XKG(6*2) 

XKG ( 8*2)  -S/30.*SK 
XKGI2*2)— 4.*XKG<8*2) 

XKG(8*8)-XKG(2*2) 

C 

SSK— SSK 

XKG<5*5)— 1.2/S*SSK 
XKGI 11 » 11 ) “XKG I  5*5  I 
XKG(11*5)— XKG(5*5> 

XKGI 11*3) —  • 1*SSK 
XKGU1.9J-XKGU1*3> 

XKGI 5  »  3 ) —XKG (11*3) 

XKG(9*5)-XKGI5*3) 

XKGI 9 • 3 ) =$/30»*SSK 
XKGI3*3)  —  A.*XKG<9*3) 

XKGI 9*9)-XKGI3*3) 

**F I LL  UPPER  TRIANGLE** 

DO  20  1-1*11 
IDIAG-H-1 
DO  20  J-IDIAG*12 
XKGI I.J)-XKG(J*I) 

20  CONTINUE 
C 

RETURN 

END 
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SUBROUTINE  OFST 


SIBFTC  OFST*  DECK 

SUBROUTINE  OFST <0FSET*GAMMA.GAM1 .GAM2I 

OFFSET  BEAM  TRANSFORMATION 

DIMENSION  OFSET I  6 ) (GAMMA (12*12) tGAM 1(6*6) *GAM2 (6*6) 

DO  100  1-1*12 
DO  100  J»l*12 
GAMMA ( I  * J) -0*0 
100  GAMMA ( I • I ) - 1 • 0 
C 

GAMMA (5*1)--0FSET(3) 

GAMMA(6*1)-0FSET(2) 

GAMMA (4*2)=OFSET(3) 

GAMMA (6*2) -“OFSET ( 1 ) 

GAMMA ( 4 • 3 ) -“OFSET ( 2 ) 

GAMMA (5*3)-OFSET(ll 
C 

GAMMA(11*7) -—OFSET ( 6 ) 

GAMMA (12.7)-0FSET<5) 

GAMMA (10*8) -OFSET ( 6 ) 

GAMMA (12*8) —OFSET ( 4 ) 

GAMMA (10*9) --OFSET ( 5 ) 

GAMMA (11*9) -OFSET ( 4 ) 

C 

DO  500  1-1*6 
DO  500  J- 1  * 6 
GAM1 ( I  * J ) -GAMMA (  I  *  J  ) 

500  GAM2 ( I  * J ) -GAMMA ( 1+6 • J+6 ) 

C 

RETURN 

END 


3586 

3587 

3588 

3589 

3590 

3591 

3592 

3593 

3594 

3595 

3596 

3597 

3598 

3599 

3600 

3601 

3602 

3603 

3604 

3605 

3606 

3607 

3608 

3609 

3610 
36H 

3612 

3613 

3614 

3615 

3616 

3617 
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SUBROUTINE  CSTIF 


SIBFTC  CSTIF*  DECK 

SUBROUTINE  CSTIF  ( AK.  *  FLXtSKAB )  3 1 7 1 

3172 

CURVED  BEAM  STIFFNESS  3173 

3174 

DIMENSION  AK  ( 12  »12 ) *FLX ( 6*6 ) »SKAA( 6  *6 ) *SKAB (6*61 »S(22) *  3175 

1TMAB!6»6) *TMABT(6*6)  3176 

3177 

COMMON /TAPES/MTl *MT2*MT3*MT4*MT5*MT6#MT7*MT8*MT9*MT10*MTU*MT12* 

*  MT13*MT14#MT15»MT16*MT17 

COMMON/VAR/NPTS*FNPTS  31«1 

COMMON/ ADPRO/EM  *G*RC  * ALFA  *DARC  »DL  3182 

COMMON/PROP T/Y I  1 100 ) *Z A ( 100 ) *X A ( 100 ) *2 II 100 ) . YA ( 1 00 ) . G J ( 100 )  3183 

3184 


I  OUT  =  MT6 
DO  10*1=1*22 

io  sm-o.o 

REM=DARC/EM 
RG-DARC/G 
RDE=RC*DARC/EM 
DSIN=SIN(ALFA/FNPTS) 

DCOS=COS< ALFA/FNPTS) 
FLEXIBILITY  MATRIX  AT  B 

DO  40  1  =  1  *NPTS 
C 

I F  <  I.NE.1IG0  TO  20 
C 

SSIN=SIN( ALFA/ (2.0*FNPTSI) 
SCOS=COS(ALFA/(2.0*FNPTS) ) 

GO  TO  30 

c 

20  SSIN-ESIN*DCOSf ECOS*DSIN 
SCOS»ECOS*DCOS-ESIN*DSIN 
C 

30  CONTINUE 

S I NSO=SS I N**2 
C0SS0=SC0S**2 
SICO=SSIN*SCOS 
SCOS1«(1.0-SCOS) 

c 

S(1)=S(1)+C0SSQ/XAII) 

5(21=3(2) *SI NSQ/YA ( I ) 
S(3)=S<3)+SC0S1**2/ZI  I  I  ) 

S<4) =S(4)+SIC0/XA( I ) 
5(5)=S(5)+SIC0/YA( I  ) 
S(6)=S(6)+(SC0S1*SSIN)/ZI (I) 
S(7)=S(7)+SC0S1/ZI  (  I  ) 
S(8)=S(8)+SINSQ/XA( I ) 

S ( 9 ) =3 ( 9 ) +COSSQ/ YA (  I  ) 

S ( 10 ) =S< 10)+SINSQ/ZI ( I  ) 
S(11)=S(  1D+SSIN/ZI  (  I  ) 

S ( 12 ) =3 ( 121*1. 0/ZA< I ) 

S< 13 )=S( 13>+SC0S1**2/GJ (  I  ) 

S ( 14 ) =S ( 14 ) +S I NSQ/Y I (  I  ) 
S(15)=S( 15)  +  (SC0S1*SC0S)/GJ(  I ) 


3185 

3186 

3187 

3188 

3189 

3190 

3191 

3192 

3193 

3194 

3195 

3196 

3197 

3198 

3199 

3200 

3201 

3202 

3203 

3204 

3205 

3206 

3207 

3208 

3209 

3210 
32H 

3212 

3213 

3214 

3215 

3216 

3217 
3216 

3219 

3220 

3221 

3222 

3223 

3224 

3225 

3226 
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S(16)=S(16)+(SC0S1*SSIN)/GJ( I  ) 

S(17)=S< 17)fSIC0/YI(  I  ) 

S( 18>=S< 18 )+COSSQ/GJ (  1  * 

S< 19)=S< 19 )+S I CO/GJ (  I  I 
S ( 20 ) =S  <  20 )+S I NSQ/GJ ( I > 

S ( 21 ) _S ( 21 )+COSSQ/Y I ( I ) 

S(22)aS(22)+l*0/ZI(I) 

C 

ES I N=SS I N 
£COS=SCOS 
C 

40  CONTINUE 
C 

DO  50  1=1*6 
DO  50  J* 1 *6 
FLX  <  J  *  I >=0.0 
SKAA( J*I ) =0.0 
SKAB ( J  *  I  1=0.0 
TMAB(J*I >=0.0 
TMABT ( J  *  I ) =0.0 
50  CONTINUE 
C 

FLX ( 1 1 1 ) =  S ( 18) *RG+S ( 14  >  *REM 
FLX ( 1 *2 ) =S ( 19 ) *RG“S ( 17 ) #REM 
FLX  (  1 *6 ) =“S ( 15  ) *RC*RG+S ( 14) *RDE 
FLX( 2.2) =S( 20)*RG+S(  21 ) *REM 
FLX<2*6>— S(16)*RC*RG-S(17)*RDE 
FLX(3*3)=S(22)*REM 
FLX(3*4)=-S(7)*RDE 
FLX(3*5)=S(11)*RDE 

FLX(4.4)=S(1>*REM‘*.S(2>*RG+S(  3)#RC*RDE 
FLX(4.5)=S(4)*REM-S(5)*RG-S(6)*RC*RDE 

FLX  <  5 . 5  >  =S  (  8  )  *REM+S  (  9  )  *RG+S  (10 )  *RC*RDE 
FLX(6*6)=S(12)*RGfS(13)*RC**2»RG-*-S{  14>*RC*RDE 
C 

DO  60  1=1*6 
DO  60  J= I *6 
60  FLX(J*I)*FLX(I*J) 

INVERT  FLX  TO  GET  STIFFNESS  AT  B 

CALL  TINVR(FLX*6.IND> 

C 

I F ( I GD.NE. 0 ) GO  TO  80 
WRITE! IOUT • 9000 ) 

9000  F0RMAT(31H1FLEXIBILITY  MATRIX  IS  SINGULAR) 

80  CONTINUE 

C 

SSIN=SIN( ALFA) 

SCOS=COS(ALFA> 

TMAB 11*1) “SCOS 
TMAB (1*2) *SSIN 
TMAB (1*6) »-RC* ( 1 . O-SCOS  ) 

TMAB(2*1)=-SSIN 
TMAB (2*2) “SCOS 
TMAB (2*6)=“RC*SSIN 
TMAB (3*31=1.0 
TMAB (3*4) “TMAB (1*6) 

TMAB (3*5) ■“TMAB ( 2  »6 ) 

TMAB (4*4) “SCOS 


3227 

3228 

3229 

3230 

3231 

3232 

3233 

3234 
32A5 

3236 

3237 

3238 

3239 

3240 

3241 

3242 

3243 

3244 

3245 

3246 

3247 

3248 

3249 

3250 

3251 

3252 

3253 

3254 

3255 

3256 

3257 

3258 

3259 

3260 

3261 

3262 

3263 

3264 

3265 

3266 

3267 

3268 

3269 

3271 

3272 

3273 

3274 

3275 

3276 

3277 

3278 

3279 
3260 

3281 

3282 

3283 

3284 

3285 

3286 


335 


TMAB ( 4 »  5 ) =  SS I N  32U7 

TMAB(5#4)=-SSIN  32b8 

TMAB (5*5) =  SCOS  3209 

TMAB (  6  *6 )  =  1  •  0  329o 

C  3291 

CALL  SMULT (TMAB*FLX*SKAB*6*6*6)  3292 

c  3293 

DO  90  I  3 1 f  6  32^4 

DO  90  Jsl»6  32 V5 

90  TMABT(J#I)«TMAB(IfJ)  3296 

C  3297 

CALL  SMULT (SKAB*TMABT*SKAA*6*6*6)  3298 

C  3299 

DO  100  1=1*6  3300 

DO  100  J» 1  * 6  330l 

AM I *J )=SKAA< I « J)  3302 

AM  I *J+6)=SKABl I *J)  3303 

AM I+6*J)»SKAB< J*I  )  33O4 

AM  1+6  *  J+6  ) =FLX (  I  *  J  )  3305 

100  CONTINUE  3306 

C  3307 

RETURN  33o0 

END  33O9 
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SUBROUTINE  CBMTR 


SI8FTC  CBMTR*  DECK 

SUBROUTINE  CBMTR (XI »YI . Z I .XF . YF • ZF . XC » YC *ZC . ALAMA . ALAMB *CLAM ) 
CURVE  BEAM  TRANSFORMATION  MATRIX 


DIMENSION  ALAMO  *3)  .ALAMAI6.6)  ♦  ALAMB  (6  *6)  .CLAM (12 *12)  » 

1RCPI 3.3) *RCN(3.3)  .  RCF<3.3) 

COMMON /TAPES/MTl *MT2 . MT3  *MT4 *MT5  *MT6  »MT7 »MT6 »MT9 »MT10 *MT 1 1 »MT1 2 . 
*  MT13.MT14.MT15.MT16.MT17 
COMMON/VAR/NPTS.FNPTS 
COMMON/ ADPRO/EM.G.RC. ALFA. DARC.DL 
COMMON/LTRAN/L1 .M1.N1.L2.M2.N2.L3.M3.N3 
REAL  L1.M1.N1.L2.M2.N2.L3.M3.N3 


3402 

3403 

3404 

3405 

3406 

3407 
3406 
3409 


3413 

3414 

3415 

3416 

3417 


I  OUT  =  MT6 

XFI=XF-XI 

YF I *  YF-Y I 

ZFI*ZF-ZI 

XCI*XC-XI 

YCI-YC-YI 

ZCI=ZC-ZI 

0S=SQRT(XFI**24YFI**2) 
DL«SQRT(XFI**2+YFI**2+ZFI**2 ) 
F=(XCI*XFI+YCI*YFI )/DS 
B=-(XCI*YFI-YCI*XFI ) /DS 
D«(-F*ZFI+ZCi*DS)/DL 
D I V=SQRT ( D*D+B*B ) 
DIVR=SQRT(XCI**2+YCI**2) 

DO  5  1*1.3 
DO  *5  J*1 .3 
10  ALAM( I . J) *0.0 
RCN ( I.J)=0.0 
5  RCP ( I »J)=0.0 

RCN ( 1 . 1 ) *  1  •  0 
RCN ( 2 . 3 ) *1 . 0 
RCN(3.2)— 1.0 

RCP ( 1 . 1 ) *1 *0 
RCP ( 2  »  3 ) =“1 • 0 
RCP ( 3 .2 ) *  1.0 


IF(DS)20. 40.60 
C 

20  WRITE! IOUT . 9000 ) X  I .YI .21 »XF .YF  »ZF 
9000  FORMAT ( 19H1LENGTH  IS  NEGAT I VE/// ( 6E 
C 

40  CONTINUE 

S I NB= YC I /D I VR 

COSB=XCI/DIVR 

ALAM(1.3)=ZFI/DL 

ALAM(2.1)«SINB*(ZFI/DL) 

ALAM(2.2)*COSB*(ZFI/DL) 


3418 

3419 

3420 

3421 

3422 
34^3 

3424 

3425 

3426 
34-^7 

3428 

3429 

3430 

3431 

3432 

3433 

3434 

3435 

3436 

3437 

3438 

3439 

3440 

3441 

3442 

3443 

3444 

3445 

3446 

3447 

3448 

3449 

.3))  3450 

3451 

3432 

3433 

3434 

3435 

3436 

3437 


n  n 


AL AM ( 3  # 1 ) =  CQSB 

3A58 

ALAM ( 3  » 2 ) =S I NB 

3459 

GO  TO  65 

3460 

3401 

60  CONTINUE 

3462 

COSB=D/D  IV 

3463 

S INB  =  B/D  IV 

3464 

ALAM ( 1,1) =XFI/DL 

3465 

ALAM( 1 ,2 )=YFI/DL 

3466 

ALAMI 1 ,3 )=ZFI/DL 

3467 

ALAMI 2 ,1 )=-COSB*< YFI/DS)+SINB»(ZFI/DL)*<  XFI/DS) 

3468 

ALAM(2»2>=COSB*(XFI/DS>+SINB*IZFI/DL)*( YFI/DS) 

3469 

ALAM(2,3)=-SINB*(DS/DL) 

3470 

ALAM  (3,1  ) —SI NB*( YFI/DS) -COSB*(ZFI/DL)*(XFI/DS 

3471 

ALAMI 3  *2  >»SINB*(XFI/DS)-COSB*lZFI/DL )*(  YFI/DS) 

3472 

ALAM (3*3) -COSB* ( DS/DL ) 

3473 

3474 

65  CONTINUE 

3475 

3476 

IF(RC.LT.0.0)G0  TO  80 

3477 

CALL  MULT  (RCP*ALAM*RCF»3»3, 3,1*0) 

3478 

GO  TO  85 

3479 

80  CALL  MULT(RCN»ALAM*RCF»3*3, 3*1*0) 

3480 

85  CONTINUE 

340  1 

3482 

L1=RCF(1,1) 

3483 

L2  =  RCF ( 2  *  1 ) 

3404 

L3=RCF (3,1) 

3485 

M1«RCF ( 1 , 2 ) 

3406 

M2=RCF (2*2) 

3487 

M3=RCF (3,2) 

3408 

N1=RCF (1,3) 

3489 

N2=RCF (2,3) 

34Y  0 

N 3»RCF ( 3  » 3 ) 

3491 

3492 

DO  110  1=1,6 

3493 

DO  110  J= 1 , 6 

3494 

ALAMAI I »J)=0.0 

3495 

10  ALAMBI I , J) =0.0 

3496 

3497 

DO  115  1=1,12 

3498 

DO  115  J  =  1 , 1 2 

3499 

15  CL AM ( I  ,J)=0.0 

35U0 

3501 

RC=A6S(RC) 

3502 

ALFA  =  DL/(2.0*RC) 

3503 

ALFA=ASIN(ALFA) 

3504 

CALFA=COS(ALFA) 

3505 

SALFA=SIN(ALFA) 

3506 

DARC=2.0*(RC*ALFA/FNPTS ) 

3507 

DL=DARC*FNPTS 

3508 

ALFA=2.0*ALFA 

3509 

3510 

3511 

ALAMAI 1 ,1) =L1*CALFA+L2*SALFA 

3512 

ALAMAI 1,2) =M1*CALFA+M2*SALFA 

3513 

ALAMAI 1,3) =N1*CALFA+N2*SALF A 

3514 

ALAMA(2,1)«-L1*SALFA+L2*CALFA 

3515 

ALAMAI 2,2 ) «-Ml*SALFA+M2*CALFA 

3516 

ALAMAI 2,3) ■~N1*SALFA+N2#CALFA 

3517 
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c 


c 


c 


c 


ALAMA ( 3 • 1 ) -L  3 

3518 

ALAMA  ( 3 • 2 ) -M3 

3519 

ALAMA ( 3  t  3 ) “N3 

3520 

3521 

ALAMB( 1*1)=L1*CALFA-L2*SALFA 

3522 

ALAMB ( 1*2) »M1*CALFA-M2*SALFA 

3523 

ALAMB( 1*3) -N1*CALFA-N2#SALFA 

3524 

ALAMB (2*1) =L 1*SALFA+L2*CALFA 

3525 

ALAMB (2*2) »M1*SALFA+M2*CALFA 

3526 

ALAMB ( 2*3)=N1*SALFA+N2*CALFA 

3527 

ALAMB ( 3  *  1 ) =L3 

3528 

ALAMB ( 3 . 2 ) “M3 

3529 

ALAMB ( 3  *  3 ) -N3 

3530 

3531 

DO  120  1=1*3 

3532 

DO  120  J=l*3 

3533 

ALAMA! 1+3 *J+3) -ALAMA (1 *J) 

35J4 

ALAMB ( 1+3* J+3) -ALAMB! I »J) 

3535 

CONTINUE 

3536 

3537 

DO  130  1-1*6 

3538 

DO  130  J-1.6 

3539 

CLAM ( 1  *  J ) -ALAMA ( I *J) 

35  AO 

CLAM ( I +6  * J+6 ) -ALAMB ( 1  * J ) 

3541 

CONTINUE 

3542 

3543 

RETURN 

3544 

END 

3545 
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SUBROUTINE  MERGE 


SIBFTC  MERGE*  DECK 

SUBROUTINE  MERGE  38/8 

C  CONTROL  SECTION  FOR  MERGE  AND  BOUNDARY  38/9 

COMMON/ CON T 1/JPART(800)  3830 

COMMON /C ON T  2/KPART(800)  3831 

COMMON /CONT 3 /LPART l 800 )  3832 

COMMON/LASTND/LN( 200)  3833 

COMMON/CONTRL/ NDEFL  *NKSP*NREX*NNFiNPSTR»NBSTRfNVIB  38  34 

COMMON/ TERMS /NBEAMtNPL ATE »NNODE * NCON D *NPS tNTOL iNP . NOPT < 4) 

COMMON/COMS/NS I ZE ( 200 )  3836 

COMMON/S K I P/NBSP  *NBSB»NBSPI iNBSBI  3837 

COMMON  /  TAPES/MTl»MT2*MT3»MT4»MT5»MT6«MT7iMT8*MT9*MT10fMTH»MT12* 

*  MT13*MT14»MT15»MT16*MTl7 
COMMON/REDUC/NT EST  »NTEST2 

C  3841 

C  3842 


I  OUT  =  MT6 
ISTIF  =  MT2 
I  KBC  =  MT3 
I KDF  =  MT4 
KFF  =  MT11 
KSTRES  =  MTS 


C 

C 

c 

c 


c 

c 

c 


c 


c 

1000 


3843 

SPACING  FOR  TAPES  LOGIC  2  AND  LOGIC 

15 

3844 

NBSP=NUMBER  OF  LOGICAL  RECORDS  FOR 

PLATE 

STRESS 

3845 

NBSP=NPLATE*8 

3846 

NBSP I “NUMBER  OF  LOGICAL  RECORDS  FOR 

PLATE 

INTERNAL  LOADS 

384-7 

NSSPI =NPLATE*2 

3848 

NBSB=NUMBER  OF  LOGICAL  RECORDS  FOR 

BEAM  STRESS 

3849 

NBsB=NBEAM*4 

3850 

NBSBI “NUMBER  OF  LOGICAL  RECORDS  FOR 

BEAM 

INTERNAL  LOADS 

3831 

NBSBI =NBEAM*3 

3832 

3833 

REWIND  ISTIF 

3834 

REWIND  I KBC 

3855 

REWIND  I KDF 

3856 

REWIND  KFF 

3837 

REWIND  KSTRES 

3860 

3861 

CALL  SOR  ( JPART*KPART#LPART*800) 

3863 

3865 

3866 

CALL  MERGBC 

3867 

IF  ( NOP T ( 3 )  .NE.  NTEST2 )  CALL  STRESS 

3870 

REWIND  ISTIF 

3871 

REWIND  I KBC 

3872 

REWIND  I KDF 

3873 

REWIND  KFF 

3874 

REWIND  KSTRES 

3877 

3878 

RETURN 

3881 

END 

3862 
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SUBROUTINE  SOR 


SIBFTC  SOR*  DECK 

SUBROUTINE  SOR  (JPARTiKPART.LPART.NPS)  3385 

3886 

SORTS  THE  CONNECTIVITY  DATA  SO  THAT  JPART  3887 

ARRAY  STARTS  WITH  THE  FIRST  PARTITION  3888 

AND  GOES  THRU  EVERY  ROW  OF  PARTITIONS  3889 

CONSECUT I VELY***1001 »2001 *2002 *3001* ETC.***  38  VO 

38  Vi 

DIMENSION  JPART(1)»KPART(1)*LPART(1)  38V2 

NPS1 =NPS“1  38V3 

DO  40  I=1*NPS1  38V4 

I F ( JPART ( I ) • EQ » 0 ) GO  TO  40  38V5 

M I  N  =  JPAR  T ( I )  38 V6 

K*I  3897 

DO  20  M  = I *NPS1  38V8 

IF(JPART(M*1). £0.0)60  TO  20  38V9 

IFtMIN.LTiJP ARTIM+l) ) GC  TO  20  3900 

MIN*JPART(M+1)  3901 

K  =  M+1  3902 

20  CONTINUE  3903 

JPART(K)=JPART(I)  3904 

JPART ( I ) “MIN  3905 

MINl-KPART(K)  3906 

KPART ( K ) »KPART ( 1 )  3907 

KPART ( I ) “MINI  39O8 

MIN2=LPART(K)  3909 

LPART ( K )  *  LPART(I)  3910 

LPARTt  I  1-MIN2  39H 

K*I  +1  3912 

40  CONTINUE  3913 

RETURN  39i4 

END  39I5 


SUBROUTINE  MERGBC 


SIBFTC  MERGB*  DECK 

SUBROUTINE  MERGBC  3919 

<-  39/0 

C  MERGE  AND  BOUNDARY  OF  STIFFNESS  3921 

c  39/2 

COMMON/CONT 1/JPARTI800)  3923 

COMMON /CONT 2 /K PART ( 800 )  3924 

COMMON/CONT 3/LP ART  (  800  )  3925 

COMMON /COMS/ NS  I Z E ( 200 )  3926 

COMMON/LASTND/LN( 200)  3947 

COMMON / T ERMS/NB E AM  * NPL A TE  #NNOD E»NCOND»NPS*NTOL  »NP  39/8 

COMMON /CONTRL / NDEFL .NKSP. NR EX. NNF  .NPSTR . NBSTR • NV I B • I F88  39/9 

COMMON/ TAPES/MTl .MT2.MT3.MT4.MT5.MT6.MT7.MT8.MT9.MT10.MT11.MT12* 

*  MT13.MT14.MT15.MT16.MT17 

c  3933 

DIMENSION  TEMPI  60 ) » I D t 60 ) • SPR I NG I  60 ) #  39+4 

INN  1 1 ( 3 ) *  NNJ 1 1 3 ) *NDI AG  I  3 )  3935 

2 * FKK  (  6  )  *  JK-K  t  6  )  •  IDDI60  )  »MNN(4)  39 36 

DIMENSION  NT { 3 )  »NB(3) »NR(3) »NL(3) *ELEM ( 60 # 60 * 3 ) *A(6*6»4) .  3937 

18(6.6.16) .JPAR (3) #KPAR( 3) .LPARI3) ♦  I  CODE (200.10)  3938 

DIMENSION  ARRAYB ( 144) ♦ ARRAYP ( 576 ) » I DRRY ( 12 )  3939 

EOUIVALENCE(ARRAYB.A) . (ARRAYP »B)  394° 

c  3941 

C  0  FREE  39H2 

C  1  ZERO  DEFLECTION  3943 

C  2  SPECIFIED  DEFLECTION  3944 

C  3  SPRUNG  3945 

c  3946 

C  NVIB  IS  A  PRINT  OPTION  3947 

INTEGER  QZ.OP  3948 

LOGICAL  NFIND.NSPR  3949 

c  39  30 

IOUT  =  MT6 
QP  -  MT8 
OZ  =  MT2 
KFF  «  MT11 
IKBC  =  MT3 

REWIND  QP  3951 

REWIND  QZ  3932 

REWIND  KFF  3933 

REWIND  IKBC  3936 

PRINT  6969  3937 

c  3938 

ZER0=0.0  3939 

DO  2  I  ■  1 .200  3962 

2  NSIZE<I>-0  3963 

C  3964 

I DI =0  3965 

NPM-0  3966 

I MK*0  3967 

Ll-1  3968 

L2»2  3989 

L3-3  3970 

c  3971 

C  3972 

4  CONTINUE  3973 

c  3974 
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c 
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WORK  WITH  THREE  PARTITIONS 
»*  DETERMINE  FIRST  AND  LAST 
JPAR(1)=JPART(L1) 
JPAR(2)=JPART(L2) 
JPAR(3)=JPART(L3) 

*•  KPART(K)-I00J  means  the 


c  ******  beam  connected  to 


c< 

c< 


c 

c< 


AND  THE  J-TH  BEAM 


A  NODE 
IS  THE 


BEAMS  AND  PLATES  IN  THIS  SET. 


I-TH  BEAM  IS  THE  FIRST 
IN  THE  K-TH  PARTITION* 
LAST  BEAM  IN  THE  K-TH 


PARTITION.  LPART  IS  A  SIMILAR  ARRAY  FOR  PLATES. 


20 


8100 


3975 

3976 

3977 
3976 
3979 


KMIN=KPART(L1)/10000 

3980 

LMIN=LPART(L1)/10000 

3981 

KMAX=KPART(L1)-10000*KMIN 

3982 

LMAX=LPART(L1) “ 10000 #LM I N 

3983 

DO  20  I=L2*L3 

3984 

KF»KP ART ( I 1/10000 

3985 

KL=KP ART ( I )-10000*KF 

3986 

LF  =  LP AR T  t I ) /10000 

3987 

LL=LPART ( I ) - 10000*LF 

3988 

IF(KL.GT.KMAX)KMAX«KL 

3989 

IF(LL.GT.LMAX)LMAX-LL 

3990 

I F ( (KF.NE.O) .AND. <KF.LT. KM INI )KMIN«KF 

3991 

I F ( ( LF.NE.O) .AND. (LF.LT.LMIN) 1LMIN-LF 

3992 

IF(KMIN.EQ.O)KMIN«KF 

3993 

IFILMIN.E0.01LMIN-LF 

3994 

CONTINUE 

3995 

3996 

t*  ZERO  OUT  AND  SIZE  THE  THREE  PARTITIONS 

MERGBC 

DO  8  K*l#3 

3998 

3999 

NI-JPAR  (Kl/1000 

4000 

NJ-JPAR  { K ) -N I *1000 

4001 

NN I 1 ( K ) =N I 

4002 

NNJ 1 ( K ) =N J 

4003 

IF(NI.NE.O) GO  TO  7 

4004 

NB ( K ) =0 

4005 

NT  (  K  )  *0 

4006 

NR ( K ) =0 

4007 

NL ( K ) =0 

4008 

GO  TO  9 

4009 

CONTINUE 

4010 

IF(NI.NE.1)NT(K)=LN(NI-1)*1 

40U 

IF(NI»EQ.1)NT(K)*1 

4012 

NB ( K ) =LN (Nil 

4013 

IFINJ.NE.1)NL(K)«LN(NJ-1)+1 

4014 

I F ( NJ • EO. 1 1 NL ( K  )  » 1 

4015 

NR(K)«LN(NJ) 

4016 

NRL«(NR(K)-NL(K)+1)*6 

4017 

NBT»<NB(K)-NT(K)-M)*6 

4018 

DO  8  J*1 *NRL 

4019 

DO  8  M“1 *NBT 

40/0 

ELEM(M.J*K)-0. 

4021 

CONTINUE 

4022 

CONTINUE 

4023 

4025 

IFINVIB.NE.l 1G0  TO  8100 

4026 

WRITE! I OUT  *9600) (NT (K) *NB ( K ) «NR ( K ) *NL ( K ) *K-1*3) 

4027 

CONTINUE 

4028 

4029 

4030 

I  F ( NBEAM«EO«0 ) 00  TO  1004 

Q 

4031 

4032 

c 

4033 

£•••••*  SPACE  TO  FIRST  BEAM  IN  THIS  SET  OF  PARTITIONS 

KB-0 

4034 

IF  ( ICM  IN —  1 )  1004.22.23 

4035 

23  KMIN1-(KMIN-1)*2 

4036 

00  21  I  SPA-  1  •  ICM  INI 

4037 

KB-KB+1 

4038 

21  READ ( OZ ) DUMMY 

4039 

KB-K.B/2 

4040 

22  CONTINUE 

4041 

PRINT  6971*  (  JPARI  IMT)  .  IMT-1.3)  .KMIN.K.MAX 

4042 

C  READING  BEAM  STIFFNESS 

4043 

15  READ ( QZ ) N 1 *N2 

4044 

NFIND-. FALSE. 

4045 

K.B-KB+1 

4046 

C 

4047 

r ******  TEST  all  combinations  of  nodes 

DO  1000  1-1.4 

4048 

GO  T0( 100.200.300.400  ).  I 

4049 

100  Ml-Nl 

4030 

M2-N1 

4031 

GO  TO  500 

4032 

200  Ml-Nl 

4033 

M2-N2 

4034 

GO  TO  500 

4035 

300  M1-N2 

4036 

M2-N1 

4037 

GO  TO  500 

4038 

400  M1-N2 

4039 

M2-N2 

4060 

500  CONTINUE 

4061 

C 

4062 

DO  800  L-1.3 

4063 

I F  < (Ml.GT.NB(L) I .OR . ( Ml . LT .NT ( L ))  )  GO  TO 

800 

4064 

I F  < (M2.GT.NRHL)  )  .OR. (M2.LT.NLIL)) )  GO  TO 

800 

4065 

C 

4066 

c******  READ  STIFFNESS.  IF  NECESSARY 

IFINFIND)  GO  TO  501 

4067 

NFIND=.TRUE. 

4068 

READ ( QZ ) (ARRAYBIMJ) .MJ- 1.144) 

4069 

501  CONTINUE 

4070 

C  ADDING  IN  BEAM  STIFFNESSES 

4071 

DO  700  N-1.6 

4072 

KR0W=(M1-NT(L) )*6+N 

4073 

DO  700  M=  1 . 6 

4074 

KC0L=(M2-NL(L) )*6+M 

4075 

700  ELEM  (  KROW  » KCOL  .  L  )  -ELEM  (  KROW  .KCOL  .L  )  *A  ( N  .M 

.1  ) 

4076 

GO  TO  1000 

4077 

800  CONTINUE 

4078 

C 

4079 

1000  CONTINUE 

4080 

IF ( .NOT .NFIND)  READ ( 02 ) DUMMY 

4081 

C 

4082 

<-**♦***  LOOP  FOR  ALL  BEAMS  IN  THIS  SET 

IFIICB.LT. KMAX)GO  TO  15 

4085 

C 

4086 

REWIND  QZ 

4087 

C 

4088 
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1004  CONTINUE  408o 

IF(NPLATE.EQ.O)GO  TO  4000  4090 

C  4091 

C  4092 

C******  SPACE  DOWN  TAPE  TO  FIRST  PLATE  IN  THIS  SET. 

NQ-0  4093 

IF(LMIN-1)4000*25*24  4094 

24  LMINl=tLMIN-l)*2  4095 

DO  26  I  SPA- 1 # LM I N 1  4096 

NQ-NQ+1  4097 

26  READ (OP ) DUMMY  4098 

NQ-NQ/2  4099 

25  CONTINUE  4100 

PRINT  6972*LMIN*LMAX  4101 

C  READING  PLATE  STIFFNESS  4102 

1005  READ(OP) (MNN( I » *1-1*4)  4103 

<:••••••  TEST  ALL  COMBINATIONS  OF  NODES. 

NFIND=. FALSE.  4104 

NQ-NQ+1  4105 

C  4106 

MLT*4  4107 

IF(MNN(4).EQ.0)MLT-3  4108 

C  4109 

DO  2900  I-1*MLT  4110 

Ml-MNN(I)  4111 

DO  2900  J-l  *MLT  4H2 

M2-MNNIJ)  4113 

C  4114 

DO  2800  L-l  *3  4115 

IF< (Ml.GT.NB(L) ) .OR. ( Ml .LT.NT(L) ) )G0  TO  2800  4116 

IFt (M2.GT.NRIL) ) . OR , (M2.LT.NLtL) ) )  GO  TO  2800  4117 

c******  read  plate  stiffness*  if  necessary. 

IFfNFIND)  GO  TO  2901  4U8 

NF I  ND  =  •  TRUE.  4H9 

READ(QP)  (ARRAYP(MJ) *MJ-1.576)  4120 

2901  CONTINUE  4121 

C  4122 

C  ADDING  IN  PLATE  STIFFNESSES  4123 

DO  2700  N= 1  * 6  4124 

KR0W=(M1-NT(L))*6+N  4125 

DO  2700  M-l*6  4126 

KC0L=(M2-NL(L) )*6+M  4127 

Nil -4* ( 1-1 ) + J  4128 

2700  ELEM ( KROW  *KCOL  »  L ) -ELEM ( KROW  »KCOL  *L)+8(N*M*NII )  4129 

GO  TO  2900  4130 

2800  CONTINUE  4131 

C  4132 

2900  CONTINUE  4133 

IF ( .NOT .NFIND)  READ  <QP)  DUMMY  4134 

C  4135 

<;•••••*  LOOP  FOR  ALL  PLATES  IN  THIS  SET. 

IFINQ.LT »LMAX )  GO  TO  1005  4138 

C  4139 

REWIND  OP  4140 

C  4141 

4000  CONTINUE  4142 

C  4143 

C  4145 

C  4146 

PRINT  6973  4147 
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BOUNDARY  CONDITIONS  4148 

4149 

4150 

4151 

*  LOOP  FOR  3  PARTITIONS. 

DO  7300  N=  1 . 3  4152 

C  4153 

IFIJPAR(N).EO.O)  GO  TO  7300  4154 

NDI AG ( N ) =0  4155 

NUNC=Q  4156 

NUNR  =  0  4157 

NBOT=NB(N)“NT(N)+l  4158 

NB0TF=N60T*6  4159 

NdOTFl*NBOTF-l  4160 

NRL*NR(N)-NL(N )  +  1  4161 

NRLF=NRL*6  4162 

NRLF 1*NRLF-1  4163 

I F ( IMK.EQ.NNI1 <N) )GO  TO  7008  4164 

K=1  4165 

N I =  NN I  1 t  N  )  4166 

C  4167 

DO  7007  I-l.NBOT  4168 

READ<  IKBC1M.  I JKLMN  4169 

CALL  UNPACK  (  I  JKLMN. JKK  ( 1 )  »JKK<2)  .  JKK ( 3 ) * JKK < 4 ) . JKK ( 5 )  .JKK<6> )  4170 

ICODE(NI .1 )= I JKLMN  4171 

NSPR  =  .FALSE.  4172 

DO  7005  L=l*6  4174 

I  F ( JKK ( L ) *NE . 3 )  GO  TO  7005  4175 

NSPR  =  .TRUE.  4176 

READ!  I  KBC )  (  FKK ( J J  )  *JJ«1  *6)  4177 

GO  TO  7006  4178 

7005  CONTINUE  4179 

7006  CONTINUE  4180 

DO  107  L=1.6  4181 

M  =  L+K**1  4182 

IF  (.NOT. NSPR)  GO  TO  107  4103 

SPRING(M)-FKK(L>  4184 

107  I D ( M ) = JKK ( L )  4185 

K=K+6  4186 

7007  CONTINUE  4187 

C  4188 

C  4190 

7008  CONTINUE  4191 

C  4192 

DO  7009  L»l»60  4193 

7009  IDDtL)-ID(L)  4194 

<:*«*•**  NDIAG(N)=1.  IF  THE  N-TH  PARTITION  IN  THIS  SET 

C*#**#*  IS  A  DIAGONAL  ONE. 

C  4195 

IFINNI 1 (N) .EQ.NNJl(N) )NDIAG  (N)-l  4196 

IK-0  4197 

IFIX-0  4198 

DO  7010  1  =  1 # NBOTF  4199 

IF((ID(I).EQ.l).OR.(ID(I).EQ.2))IK-IK+l  4200 

7010  CONTINUE  4201 

I F  < IK. EQ.  NBOTF) IFIX=1  4202 

IF(NDIAGIN) .NE.l )GO  TO  7030  4203 

I DI= I DI+1  4204 

NS IZE ( ID  I ) * NBOTF- IK  4205 

I F ( .NOT .  NSPR)  GO  TO  7030 
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C  ADO  SPRING  CONSTANTS  TO  DIAGONAL  TERMS  4207 

DO  7025  1*1 »NB0TF  4208 

IF( 1 0 ( I ) .NE.3IG0  TO  7025  4209 

ELEMI ItI*N)*ELEM( I*I*N)+SPRI NG ( I )  4210 

7025  CONTINUE  42|x 

7030  CONTINUE  42f2 


4213 


******  SORT  CONSTRAINED  ELEMENTS  TO  BOTTOM. 

DO  7035  1  =  1  iNBOTF 
I  I=NB0TF-I+1 

I  F ( t I D(  I  I) .EQ.l ) .OR. I  1 D ( 1 1) .EQ.2) )GO  TO  7038 
7035  CONTINUE 
7038  I  LAST* 1 1 
JJJ  =  0 


DO  7150  I-l.ILAST 
I  JK  =  0 

I F ( ( I D ( I ) .NE.l ) .AND. ( IDI I ) .NE.2) )GO  TO  7150 
I  JK*  1 

IF( JJJ.EQ«0) I JK  =  0 
JJJ=JJJ+1 
KK=  I - J J J+l 
NUNR=NUNR+1 

IFINDIAG(N).NE.l) GO  TO  7044 
NUNC=NUNR 
GO  TO  7050 
7044  CONTINUE 

I  TR  =  NNJ 1 (N ) 

NUN1=NSIZE( ITR ) 

NUNC=NRLF-NUN1 
7050  CONTINUE 

DO  7060  L*1 #NRLF 
TEMP  (L)=ELEM(KK*L*N) 

7060  CONTINUE 


DO  7080  K=KK . NBOTF1 
DO  7080  M*1 »NRLF 
ELEM(K#M*N)«ELEM(K+1»M*N) 
7080  CONTINUE 


4214 

4215 

4216 

4217 

4218 

4219 

4220 

4221 

4222 

4223 

4224 

4225 

4226 

4227 

4228 

4229 

4230 

4231 

4232 

4233 

4234 

4235 

4236 

4237 

4238 

4239 

4240 

4241 

4242 

4243 

4244 

4245 

4246 

4247 

4248 


*•**  SORT  CONSTRAINED  ELEMENTS  TO  RIGHT. 

DO  7090  1 1 - 1 » NRLF 
ELEM ( NBOTF  >11 *N ) =TEMP  t I  I ) 

7090  CONTINUE 
7150  CONTINUE 

NJ  =  NNJ 1 1  N ) 

K-l 

DO  108  1  =  1 » NRL 

CALL  UNPACK  I  I  CODE! NJ* I ) *  I D I K ) ♦ ID ( K+l ) *ID(K+2 ) * IDIK+3) .IDtK+4) ♦ 
1  IDIK+51) 

108  K=K+6 

DO  101  1  =  1  *  NRL  F 
ILAST=NRLF-I+1 

IFKID(ILAST).  EQ.l).  OR.  (IDULAST).  EQ.2))  GO  TO  102 

101  CONTINUE 

102  JJJ-0 


4249 

4250 

4251 

4252 

4253 

4254 

4255 

4256 

4257 

4258 

4259 

4260 

4261 

4262 

4263 

4264 
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DO  1C3  I=1*ILAST  4265 

I F  < ( I D ( I ) .NE.l ) .AND. ( I D ( 1 ) .NE.2))  GO  TO  103  4266 

JJJ=JJJ+1  4267 

KK=I-JJJ+1  4268 

DO  104  L=1 *NBOTF  4269 

104  TEMP(L)=ELEM(L»K.K.N)  4270 

DO  105  K=KK»NRLF1  4271 

DO  105  M=1 »NBOTF  4272 

105  ELEM(M»K»N)«ELEM(M»K+1*N)  4273 

DO  106  L=1*NB0TF  4274 

106  ELEM( L *NRLF»N) -TEMP ( L )  4275 

103  CONTINUE  4276 

C  4277 

IF( ( IK.NE.O) .OR. (NDIAG(N) .EO.l ) ) GO  TO  7155  4278 

I TR=NNJ 1 ( N )  4279 

NUN1=NSIZE( ITR  )  4280 

NUNC=NRLF-NUN1  4281 

7155  CONTINUE  4282 

I F (  (  IFIX.NE.l ) .OR, (NDIAG(N) .EQ.l ) >GO  TO  7165  4283 

I TR  =  NN J 1 ( N  )  4284 

NUN1-NSIZEI ITR  )  4285 

NUNC=NRLF-NUN1  4286 

7165  CONTINUE  4287 

C  4288 

C  4289 

NROW=NBOTF-NUNR  4290 

NCOL=NRLF-NUNC  4291 

NBR=NR0W+1  4292 

NBC=NCOL+l  4293 

4294 
4298 

******  WRITE  STIFFNESS  PARTITIONS  ON  TAPE. 

IF< < IK.EQ.O) .AND. (NDIAG(N) .EQ.l ) )GO  TO  7280  4299 

I  F  (  (  IK.EQ.O)  .AND.  (NDIAG(N)  .NE.DIGO  TO  7168  4300 

I  F  < (  IFIX.NE.l) .OR. (NDIAG(N). NE.l) )GO  TO  7162  4301 

C  4302 

K8=JPAR(N) +1000000 

K8COL  =  NRLF  4307 

K8ROW=NBOTF  4308 

8200  CONTINUE  4321 

GO  TO  7296  4322 

C  4323 

7162  CONTINUE  4324 

I  F ( (  IFIX.NE.l ) .OR. (NDIAG(N) .EQ.l ) )GO  TO  7164  4325 

I  TR  =  NNJ  1  ( N )  4326 

NUN1=NSIZE( ITR)  4327 

I F ( NUN  1  .NE.  NRLF  )  GO  TO  7163  4328 

K8=JPAR(N)+2000000 

K.8COL  =  NRLF  4333 

K8ROW=NBOTF  4334 

8300  CONTINUE  4347 

GO  TO  7296  4348 

7163  CONTINUE  4349 

7164  CONTINUE  4350 

C  4351 

IF (NBC. GT. NRLF )  GO  TO  8400  4352 

K38=K88+1  4355 

K8=JPAR(N)+1000000 

K8ROW=NBOTF-NBR+l  4358 

K8COL=NRLF-NBC+l 


348 


nnn  nnn 


8400 


8500 

C 

7168 


8600 

7176 


CONTINUE 

IFINCOL.EQ.OIGO  TO  8500 
K8“JPAR(N)+2000000 
K8C0L=NC0L 
K8R0W=NB0TF-NBR+1 

CONTINUE  _  _ . 

I F I  I  IF IX*EQ. 1 ) • AND* l NDI AGIN ) *NE* 1 ) )G0  TO  7296 


CONTINUE 

IFINNI 1  IN) .EQ.NNJ1 IN) )G0  TO  7200 
I  F ( < I K*NE»0 ) *OR • ( NDI AG  I N) .EQ.l > )GO 
I TR=NNJ 1 1  N ) 

NUN1=NS I 2E ( ITR) 

I F ( NUN1 • NE  *NRLF )GO  TO  7176 

CALL  WRTETP I ELEMI 1  *  1 *N ) .60.JPARIN)* 

<8= JP ARI N) +4000000 


TO  7178 


NBOTF*NRLF* IDRRY  »0*0» 


KFF.IRROR) 


K8C0L=NRLF 

K8ROW=NBOTF 

IFINVIB.NE.1IG0  TO  8600 

CALL  PRINT ( ELEM ( 1 *1 »N ) ♦  K8ROW #K8COL *  1 . 5HST IFF, 0*60) 

CONTINUE 

GO  TO  7296 

CONTINUE 


C 

7178 


C 


8700 

7200 

C 

7280 


8800 


CONTINUE 

I F I  NBC  *GT *NRLF )  GO  TO  8700 
j  ppar  =  nNJ1 IN )*1000+NNl 1 (N ) 

KCF  TERM  FOR  OFF  DIAGONAL  PARTITION 

K8=JPAR(N)+3000000 

K8COL=NRLF-NBC+ 1 

K8ROW=NROW 

CONTINUE 

CONTINUE 


CONTINUE 

CALL^WRTETP  I  ELEMI  1  *1  *N  )  *60#  JPAR  I  N  )  *NROW  *NCOL*  I DARR Y  *0  *0  * K.FF  »  IRROR  ) 

K8=JPAR(N)+4000000 

K8C0L=NC0L 

K8ROW*NROW 

I F I NV I B • NE • 1 ) GO  TO  8800 

CALL  PRINT  (ELEMI1*1*N)  #X8ROW  » K8COL  *1*5HSTIFF*0»60) 

CONTINUE 


C 

7296  CONTINUE 
C 

DO  7298  L=1 *60 
7298  I D I L ) = I DD I L ) 

I MK  =  NN I 1 I N ) 


7300  CONTINUE 


NPM=NPM+3 
L 1*L 1+3 
L2=L2+3 
L3*=L3  +  3 


4371 


4376 

4377 

4390 

4391 

4392 

4393 

4394 

4395 

4396 

4397 

4398 


4403 

4404 

4415 

4416 

4417 

4418 

4419 

4420 

4421 

4422 

4423 

4424 

4429 

4430 

4443 

4444 

4445 

4446 

4447 


4452 

4453 

4464 

4465 

4466 

4467 

4468 

4469 

4470 

4471 

4472 

4473 

4474 

4475 

4476 

4477 

4478 

4479 

4480 

4481 

4482 

4483 
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TEST  FOR  TOTAL  NUMBER  OF  PARITIONS 
PRINT  6974 

I F ( NPM •  L  T  #  NTOL ) GO  TO  4 
REWIND  KFF 
REWIND  IK.BC 

C******  CONVERT  K.PART  AND  LPART  ARRAYS  TO  FORM  COMPATIBLE  WITn 
C******  SUBROUTINE  MFORCE • 

DO  30  1=1 »NTOL 

KPART  (  I  )  =KPART  (  I  J-IKPART  (  I  )  / 1 0000  )*  10000 
30  LPART ( I ) =LPART ! I ) - 1 LPART ( I ) / 1 0000 >* 10000 
PRINT  6970 


9001 

9600 

6969 

6970 

6971 

6972 

6973 

6974 


FORMAT! 
FORMAT! 
FORMAT ( 
FORMAT! 
FORMAT! 
FORMAT! 
FORMAT! 
FORMAT ( 


16H  JR88  IDENT  NO.  I6.10X.I2.4H  BY 
24H1NT  MB  NR  NL///!4I8) 


1H 

.11HBEGIN 

MERGE) 

1H 

. 09HEND  MERGE) 

1H 

.7HJPAR  = 

.3!  16. 1H,  ) 

.7HKMIN 

1H 

.7HLMIN  = 

.16. 7HLMAX 

-  .16) 

1H 

.8HSTART 

BC) 

1H 

•  6HEND  BC 

) 

12) 

) 

6  » 7HKMAX 


•  16  ) 


C 

7400  RETURN 
END 


4484 

4485 

4486 

4487 
4489 
4492 


4496 

4497 

4498 

4499 

4500 

4507 

4508 

4509 

4510 

4511 

4512 

4513 

4514 

4515 

4516 
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SUBROUTINE  STRESS 


SlBFTC  STRES*  DECK 

SUBROUTINE  STRESS 


CONTROL  section  for  stress  calculations 


COMMON /TERMS/NBE AM* NPLATE  *NNODE*NCOND*NP S*NTOL*NP 
COMMON / CONTRL / NDEFL  *NKSP  *  NR EX  *NNF  *NPSTR  *NBSTR  tNVIB 
COMMON/SKI P/ NBSP  *NB$B*NBSPI *NBSBI 

COMMON/PBSIZE/IPB#IPBL*IPBN»NELEM*NOD 

COMMON/T APES/MT 1 *MT 2  » MT 3  *MT4 *MT5  *MT6  *MT7  *MT8 »MT9 *MT 10 *MT 1 1 *MT 1 2  * 


*  MT13*MT14*MT15*MT16*MT17 
COMMON/LOADS/BI G1 <96  *60 ) 


LIST  OF  ARGUMENTS  FOR  PLATES  AND  BEAM  MERGER 

nelem*  nplate  nbeam 


c 


c 

c 


c 


c 


I  OUT  =  MT6 
ISTRS  »  MT16 
REWIND  ISTRS 

I F ( NPLATE  .EQ*  0)  GO  TO  10 

IPB  =  12 
IPBL  =  96 
I PBN=0 

NELEM=NPLATE 
N0D  =  4 
PRINT  91 
PRINT  92 
CALL  MSTRES 
10  CONTINUE 

I F ( NBEAM  *EQ*  0)  GO  TO  20 

IPB  =  8 
IPBL  =  96 
I  PQN  =  1 2 
NELEM=NBEAM 
NOD  =  2 

PRINT  93 
PRINT  94 
CALL  MSTRES 
20  CONTINUE 


RETURN 

91  FORMAT (12H  CALL 

92  FORMAT (12H  CALL 

93  FORMAT (12H  CALL 

94  FORMAT (12H  CALL 
END 


I  PLATE ) 
PSTRES) 
IBEAM) 
BSTRES ) 


4849 

4860 

4861 

4862 

4863 

4864 

4865 


4860 

4861 

4862 

4866 

4867 


4869 


4872 

4873 


4876 

4877 

4879 


4882 

4883 

4884 


4887 

4888 

4889 


4890 
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SUBROUTINE  MSTRES 


SIBFTC  MSTRE*  DECK 

SUBROUTINE  MSTRES 

COMMON/CONTRL/NDEFL*NKSP*NREX*NNF*NPSTR*NBSTR.NVIB  5195 

COMMON/ L AS TND/LN ( 200 )  5196 

COMMON/TERMS/NBEAM*NPLATE  *NNCDE*NCOND*NPS.NTOL*NP  5197 

COMMON/SKI P/NBSP  *NBSB*NBSPI  *NBSBI  5198 

COMMON/PSSIZE/IPB*IP6L •  I PBN * NELEM ,NOD 


COMMON /T  APES/MTl*MT2*MT3*MT4*MT5*MT6*MT7*MT8*MT9*MT10*MTll*MT12» 
*  MT13*MT14*MT15*MT16.MT17 
CO'IMON/YAPSTR/IPTOT*  IBTOT 
C  NOD  =  2  FOR  BEAMS*  4  FOR  PLATES. 

DIMENSION  B 10(96*60) *A( 68*8*6) *NN(68> 

EQUIVALENCE! A. B) 

DIMENSION  3(22*12*6) 

COMMON/LOADS/BIG 
LOGICAL  LAST 


I  out  =  MT6 
ISTRS  =  MT 16 
KSTRES  =  MT  8 
C  INITIALIZE 

NTOT  =  0 

IF( (NPLATE.EQ.O).OR.(NPSTR.NE.O) )  GO  TO  11 
DO  10  1=1 *NBSP I 

10  READ { ISTRS)  NDUM 

11  CONTINUE 
NTIM=NELEM/IP6 
NTIML=NELEM-NTIM*IPB 
NL IM  =  NT  I M 

IF(NTIML.NE.0)NLIM*NLIM+1 
LAST= .FALSE. 

C  LOOP  FOR  SETS  OF  ELEMENTS 

DO  2000  LPL=1*NLIM 
IF(LPL.GT.NTIM)  LAST=.TRUE. 

2001  ML IM= I PB 
IF(LAST)MLIM=NTIML 

C  READ  IN  STRESSES 

DO  3100  K= 1 *ML I M 
KN 1 =K+ML I M 
KN2=KN1+ML I M 
KN3=KN2+MLIM 
I F ( N0D.E0.2 )  GO  TO  2002 

READ) ISTRS)  NB  *NN ( K ) *NN ( KN1 ) *NN ( KN2 ) * NN ( KN3 ) 

READ (ISTRS) ( ( A (K* I  * J) *  I  =  1*1 PBN) . J= 1 . 6 ) . ( ( A ( KN 1 • I  * J ) *  I « 1 , 1 PBN ) , J= 1 
1 *6) * ( ( A( KN2* I  * J) . 1  =  1 *IPBN) *J«1*6) •( ( A ( KN 3  *  I . J ) . I ■ 1 , I PBN ) , J= 1  ,6 ) 

GO  TO  3100 

2002  READ ( ISTRS)  NB  *NN ( K ) *NN ( KN1 ) 

READ! ISTRS)  (<B(K*I.J) *  1-1  *  I PBN) * J= 1 *6 ) * ( ( B ( KN1 *  I  * J ) » 1  =  1  *  I PBN)  ,J  =  1 
1  *6) 

3100  CONTINUE 
LL IM=KN3 

I F ( NOD. EG . 2 )  LL I M=KN 1 
C  LOOP  FOR  PARTITIONS 

DO  4100  K=1 »NPS 
IRITE=0 

DO  300  I  =  1  *  I PBL 


3306 

5307 
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5312 


DO  300  J  =  1 » 60 
300  BIG(IiJ)=0*0 

DO  3800  L“ 1 • LL I M 

C  CHECK  TO  SEE  IF  NODE  IS  IN  THIS  PARTITION 

IFtK.NE.llGO  TO  3450 
IFtNN(L) .EQ.O)  GO  TO  3800 
IF(NN(L)»GT*LN(1) ) GO  TO  3800 
GO  TO  3400 
3450  CONTINUE 

I F ( (NN(L).GT.LN(K) ).OR.  ( NN I L ) ,l£. LN ( K-l ) ) » GO  TO  3800 
3400  CONTINUE 
I  R I T  E  =  1 


3460 

3480 

3701 

3700 

3800 

C 


3900 

4000 

C 

4100 

C 

2000 


5000 

9001 

9002 

5001 


ADD  IN  STRESSES 
DO  3700  N“1 * IPBN 
L1«L-1 

KROW= ( MOD ( L 1 *ML I M ) )*IPBN+N 

DO  3700  M= 1 1 6 

IF ( K«NE« 1 )GO  TO  3460 

KCOL=(NN(L)-l)*6+M 

GO  TO  3480 

CONTINUE 

KCOL  =  (NN(L)-LN(K-D-l  >*6+M 
CONTINUE 

I F ( N0D«EQ»4)  GO  TO  3701 
B I G ( KROW  *KCOL)"B(LtN*M) 

GO  TO  3700 

B I G ( KROW  *KCOL)«A(L*N*M) 

CONTINUE 
NN ( L ) =0 
CONTINUE 

IF*  IRITE.NE.DGO  TO  4000 
NTOT  =  NTOT+l 

WRITE  STRESS  PARTITION  ON  TAPE 
MAP=1000*LPL+K 
WRITE(KSTRES)MAP 
NSUE  =  LN(  1 )  *6 

IF(K,GT.1)NSIZE=(LN(K)-LN(K-1 ))*6 
KNN= I PBL 

IF(LAST)KNN«IPBN<NTIML 

WRITE ( KSTRES) ( (BIG( I *J) *I-1*KNN) »J»1*NSIZE) 

I  F ( NV I B • NE • 1 ) GO  TO  3900 

IF(N0D.E0.2)  WRITE! IOUT#9001 )  MAP 

IF (N0D«EQ»4)WRITE! 10 UT  *9002)  MAP 

CALL  PRINT (BIG*KNN*NSIZEtlt4H  BIG*1»48) 

CONTINUE 

CONTINUE 

CONTINUE 


CONTINUE 

I F ( NOD* EO* 2  I  GO  TO  5000 
IPTOT=NTOT 
GO  TO  5001 
IBTOT  =  NTOT 

FORMAT ( 22H  MERGED  BEAM  STRESSES  *  1 8  *  1 5HWR I TTEN  ON  TAPE) 
FORMAT ( 23H  MERGED  PLATE  STRESSES»I8t 15HWRITTEN  ON  TAPE) 
RETURN 
END 


5313 

5314 

5316 

5317 

5318 

5319 


5322 

5323 

5324 

5325 

5326 

5327 

5328 


5330 

5331 

5332 

5333 


5336 

5337 


534Q 


5343 

5347 

5348 

5349 

5350 
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SUBROUTINE  SOLN 


$  I BFTC  SORCON  DECK 

SUBROUTINE  SOLN 

COMMON /SORT /NSAVEI7000) *N2<200) iNPART ( 200 ) .NPART2 ( 200 ) 

COMMON /TERMS/NBE AMS  .NPLATE • NNODE»NCOND*NPS*NTOL *NP  »NOPT ( 4 ) 
COMMON/ T  APES/MTl*MT2»MT3»MT4»MT5*MT6*MT7*MT8»MT9*MT10*MTll»MT12» 
*MT13»MT14»MT15*MT16»MT17 
COMMON /COMS/ NS  I ZE ( 200 ) 

COMMON/CONT 1/JPART ( 800 ) 

COMMON /RS I ZE/ISI2E(500) .NROW » JS I ZE ( 200 ) 

COMMON/MAPSTR/IPTOT* IBTOT 
COMMON / CONT  EM / NP  R  R  »  NP  R 
COMMON/REDUC/NTEST  .NTEST2 
CALL  FKSORT 
CALL  KFFSRT 
CALL  CONECT 

IF  ( NOPT ( 3 )  .EQ.  NTEST2)  GO  TO  20 
NELEM  =■  12 
NSTRS  =  8 

IF  (NPLATE  .EQ.  OJ  GO  TO  10 
C  SORT  PLATE  STRESS  MATRIX 
REWIND  MT8 

CALL  DELETE  ( 0 » NELM .NSTRS ) 

CALL  SSORT  ( 0 » NELEM .NSTRS ) 

10  CONTINUE 

IF  ( NBEAM  .EQ.  0)  GO  TO  20 
NELEM  o  8 
NSTRS  ■  12 

C  SORT  BEAM  STRESS  MATRIX 

CALL  DELETE  ( 1 .NELEM, NSTRS) 

CALL  SSORT ( 1. NELEM. NSTRS) 

20  CONTINUE 
RETURN 
END 
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SUBROUTINE  TEST 


O 

SIBFTC  TEST*  DECK 

SUBROUTINE  TEST < M *N *MAT *NPR . ITEST )  5493 

***  TESTS  MATRIX  MAP  MAT(I)  TO  SEE  IF  PARTION  1000*M+N 

APPEARS  in  stiffness  matrix 

DIMENSION  MAT {  1 )  5494 

NUM=1000*M+N  5498 

DO  1  I ■ 1 *NPR  5499 

IFiNUM.EQ.MATII ) )GO  TO  2  5500 

1  CONTINUE  5501 

NUM=1000*N+M  5502 

DO  10  I ■ 1 »NPR  5503 

IF(NUM.EQ.MAT( I ) )GO  TO  2  5504 

10  CONTINUE  5505 

I  TEST  =  0  5506 

GO  TO  3  5507 

2  ITEST “1  5508 

3  CONTINUE  5509 

RETURN  5510 

END  5511 
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SUBROUTINE  FKSORT 


SIBFTC  FKSRT  DECK 

SUBROUTINE  FKSORT 
C 

C  THIS  SUBROUTINE  CREATES  THE  NSAVE  ARRAY  WHICH  CONTAINS  THE  LIST  OF  ELEMENT 
C  NUMBERS  THAT  ARE  TO  BE  RETAINED  AND  THE  NZ  ARRAY  WHICH  CONTAINS  THE  NUMBER 
C  OF  RETAINED  ELEMENTS  IN  EACH  PARTITION. 

C 

COMMON/L ASTND/LN ( 200 ) 

COMMON/ TERMS /N BE AM  »  NPLA  TE  »NNODE  *NCOND#NPS*NMAX*NP 
COMMON /TAPES/MTl * MT2 . MT 3 »MT4 »M T5 «MT 6 *MT 7 #MT8 »MT 9 .M T 10 .MT 1 1 »M T 1 2 . 

*  MT13.MT14.MT15 .MT16.MT17 
COMMON /SORT /NSA VE (  7000) *NZ(200) 

COMMON/CONT 1/JPART  (  800 ) 

COMMON/CONT  EM/f'lPRR  »  NPR 
COMMON/COMS/NSIZE (200 ) 

DIMENSION  I R ( 60 ) *NTEMP ( 800 ) * IC ( 60 )  . 

***  NOMENCLATURE  ***  ***  ***  ***  ***  ***  ***  ***  ***  *** 

NTOL  =  TOTAL  NUMBER  OF  RETAINED  FREEDOMS 
NNZ  COUNTS  RETAINED  FREEDOMS  FOR  THIS  PARTITION 

NZ  =  ARRAY  CONTAINING  THE  NUMBER  OF  RETAINED  FREEDOMS  FOR  EACH  PARTITION 
NSAVE  -  ARRAY  OF  ELEMENT  NUMBERS  OF  THE  STIFFNESS  MATRIX  WHICH  ARE  TO  BE 
RETAINED 

IR  =  ARRAY  CONTAINING  REDUCTION  INFORMATION  FOR  THIS  PARTITION 
IR(N)  ■  1  IF  THE  NTH  FREEDOM  IS  TO  BE  RETAINED.  AND  ZERO  IF  IT  IS  TO  BE 
REDUCED. 

LN  «  ARRAY  CONTAINING  LAST  NODES  FOR  EACH  PARTITION. 

NMAX  ■  TOTAL  NUMBER  OF  PARTITIONS  (ELEMENTS  IN  JPART  ARRAY) 

NPR  =  NUMBER  OF  KFF  PARTITIONS  (ELEMENTS  IN  NTEMP ) 


THE  NSAVE  ARRAY  IS  CONSTUCTED 


NSAVE(l) 
NSAVE ( 2 ) 
* 

* 


FIRST 

2ND 


RETAINED 

RETAINED 

* 

* 

ETC 


AS  SHOWN  BELOW 
ELEMENT  NUMBER**** 
ELEMENT  NUMBER  * 


•FIRST  PARTITION 


NSAVE ( NZ ( 1 ) )  « 
NSAVE ( NZ ( 1 ) +1 ) 
NSAVE ( NZ ( 1 ) *2 ) 
* 

* 


LAST  RETAINED  ELEM.  NUMBER*** 

-  1ST  RET.  ELEM.  NUMBER  * 

2ND  RET.  ELEM.  NUMBER  * 

* 

* 

ETC. 


♦SECOND  PARTTITION 


NSAVE ( NZ ( 1 )+NZ( 2 ) ) ************************** 


* 

* 

* 

* 


♦LAST  PARTITION 


NSAVE ( NTOL )  ■  LAST  RET.  ELEM.  NUMBER******** 


C  INITIALIZE  ALL  ARRAYS  AND  COUNTERS. 
I  OUT  =  MT6 
N 18  =  MT  1 
ISTIF  *  MT2 
I KBC  =  MT3 
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REWIND  N 18 
REWIND  ISTIF 
REWIND  IK.BC 

NPR  =  0 
DO  4  K  =  1 »NPS 

IF  (NSIZE(K)  .EQ.  0)  GO  TO  4 
NPR  «  NPR  +  1 
NTEMP(NPR)  «  K*1000  +  < 

IF  t K  .EQ.  1)  GO  TO  4 
NEND  =  K-l 
DO  3  1*1 .NEND 

IF  (NSIZE! I)  .EQ.  0)  GO  TO  3 
CALL  TEST  (K.I # JPART . NMAX . I  TEST ) 

IF  ( ITEST  • EQ.  01  GO  TO  3 
NPR  =  NPR  +  1 
NTEMP  (  NPR )  *  K+1000  +  I 

3  CONTINUE 

4  CONTINUE 

DO  6  I “1 »NPR 
JPART (  I  )  -  NTEMP ( I ) 

6  CONTINUE 

NTOL  -  0 
DO  5  J*1 *200 

5  NZ ( J )  ■  0 

LOOP  FOR  EACH  PARTITION 
D(J  100  I  « 1 » NP 

CALCULATE  FIRST  AND  LAST  NODE  NUMBERS  FOR  THIS  PARTITION 

I F ( I  .EQ.  1 )  GO  TO  7 
N 1  =  LN( I— 1 )  ♦  1 
N2  =  LN ( I ) 

GO  TO  8 

7  CONTINUE 
N 1  «  1 
N2  =  LN(1) 

8  CONTINUE 
NROW  -  6MN2-N1  +  1) 

M  -  1 

READ  RETAINED  FREEDOMS  FROM  TAPE  FOR  ONE  NODE  AND  ADD  TO  LIST  FOR  THIS  PART. 

DO  10  N=N1 »N2 
READ  ( N18 )  NCODE 
I F ( NCODE  «NE.  N)  GO  TO  9990 

READ  ( N 1 8 )  I R ( M ) . I R ( M+l ) *  I R ( M+2 ) # I R ( M+3 ) *  I R ( M+4 ) » I R I M+5 ) 

C  READ  BOUNDARY  CONDITIONS 

READ ( I KBC I  NODE. I JKLMN 
I F ( NODE  .NE«  N)  GO  TO  9991 

CALL  UNPACK! I JKLMN.ICIM) *IC< M+l) .ICIM+2) . IC ( M+3 >  1 1 C < M+4 ) • IC ( M+5 ) ) 

ISP  -  0 
M6  ■  M+5 
DO  9  IT»M.M6 
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IFUC(IT)  .EQ.  3)  ISP  ■  1 
9  CONTINUE 

I  F  (  I  S'P  .  EQ*  1)  READ  (  I KBC  )  01 »D2 .03  * D4.D5 t D6 
M  ■  M+6 
10  CONTINUE 
20  CONTINUE 
NNZ  =  0 

C  START  SORTING  LOOP 

C 

J  *  0 

DO  50  JJ« 1 »NROW 

IFKIC(JJ)  .EQ.  0)  .OR.  IIC(JJ)  .EQ.  3))  J  -  J  ♦  1 
TEST  FOR  RETAINED  FREEDOM 

I F ( I R ( J J )  .NE.  1)  GO  TO  50 

UPDATE  COUNT  OF' RETAINED  ELEMENTS  AND  ADD  J  TO  ARRAY  OF  RETAINED  ELEMENT  NO.S 

NTOL  =  NTOL  ♦  1 
NN2  =  NNZ  ♦  1 
NSAVE ( NTOL )  -  J 
50  CONTINUE 

SAVE  THE  TOTAL  NUMBER  OF  RETAINED  FREEDOMS  FOR  THIS  PARTITION 

NZ(I)  -  NNZ 

100  CONTINUE 

REWIND  I KBC 
RETURN 


9990  WRITE  (IOUT.9000)  NCODE.N 
STOP 

9991  WRITE  ( I  OUT . 9001 )  NODE.N 
STOP 


9000  FORMAT (103H1ERROR  IN  SUBROUTINE  FK.SORT .  THE  PARTITION  NUMBER  READ 
♦FROM  TAPE  DOES  NOT  AGREE  WITH  WHAT  WAS  EXPECTED. //27H  PARTITION  NU 
♦MBER  READ  WAS  I3.14H  IT  SHOULD  BE  13) 

9001  FORMAT ( //52H  NODE  NUMBER  READ  FROM  I KBC  IN  FKSORT  WAS  INCORRECT./ 

♦  16H  NUMBER  READ  WAS . I  8  * 5X ♦ 19HI T  SHOULD  HAVE  BEEN. 18) 

END 
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SUBROUTINE  KFFSRT 


SIBFTC  KFSRT  DECK 

SUBROUTINE  KFFSRT 

COMMON/SORT /NSAVE (  7000 ) »NZ < 200 ) »NP ART ! 200 > .NPART2 ! 200 ) 

COMMON /T  APES/MT1.MT2.MT3.MT4.MT5.MT6  »MT7  .MT8.MT9.MT10.MT11.MT12* 

*  MT13.MT14.MT15.MT16.MT17 
COMMON/TERMS/NBEAM.NPLATE.NNODE.NCOND.NPS.NTOL.NP 
C0MM0N/C0MS/NS IZE ( 200  ) 

COMMON/CONT 1/MAT ( 800  > 

COMMON /CONT EM/ NPRR  *NPR 

DIMENSION  STIFF (60*60 ) .SORTED ! 60 .60 > .8 1 12 > 

THIS  SUBROUTINE  SORTS  THE  KFF  MATRIX  INTO  RETAINED  (Kll).  DELETED  <K22>*  AND 
DELETED-RETAINED  (K21J  PARTITIONS.  IT  THEN  WRITES  THEM  ON  TAPE  IN  TL01  FORMAT. 

#*#  NOMENCLATURE  ***  ***  ***  ***  ***  ***  ***  ***  ***  ***  ** 

NP  -  TOTAL  NUMBER  OF  PARTITIONS 

NZ  »  ARRAY  CONTAINING  TOTAL  NUMBER  OF  RETAINED  FREEDOMS  FOR  EACH  PARTITION 
NSAVE  ■  ARRAY  OF  RETAINED  ELEMENT  NUMBERS 
IS IZE  ■  SIZE  OF  THE  PARTITION  BEING  PROCESSED. 

STIFF  -  UNSORTED  STIFFNESS  MATRIX  READ  IN  FROM  TAPE 
SORTED  =  SORTED  STIFFNESS  MATRIX  WRITTEN  OUT  ON  TAPE  IN  TL01  FORMAT 

I  OUT  =  MT6 
KFF11  =  MT16 
KFF12  *  MT12 
KFF21  -  MT2 
KFF22  -  MT1 
KFF  *  MT 11 

REWIND  KFF11 
REWIND  KFF12 
REWIND  KFF21 
REWIND  KFF22 
NFILE  -  0 
NMAT  *=0 
REWIND  KFF 
DO  205  K-l.NP 
NCNT  =  0 
NCOUNT  »  0 
NCNT 1  ■  0 
NCNT 2  ■  0 
DO  200  L-l.K 
DO  5  1=1*60 
DO  5  J-1.60 
SORTED! I  * J)  -  0.0 
STIFF! I.J)  ■  0.0 
5  CONTINUE 
N12  *  0 
Nil  =  0 

ID  ■  1000*K  +  L 
CALL  TEST  !K»L .MAT.NPR *  I  TEST ) 

C 

C  IF  THERE  IS  NO  KOOL  PARTITION.  NULL  MATRICES  WILL  BE  WRITTEN  ON  TAPE 
ISIZEN  =  NSIZE(K) 

ISIZEM  =  NSIZE(L) 

IF  ( ITEST  ,NE.  1)  GO  TO  160 
N22  =  NZ1K) 

N21  =  NZIK) 

I F ( NS  I ZE ( K )  .EQ.  0)  GO  TO  201 
IF(NSIZEIL)  .EQ.  0)  GO  TO  200 
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C  CALCULATE  LOCATION  OF  RETAINED  FREEDOMS  FOR  THIS  PARTITION 
IF  (K.  .EQ.  1)  GO  TO  10 
NFIRST  =  0 
DO  7  N1 “2  »K 

NFIRST  *  NFIRST  +  NZINl-l) 

7  CONTINUE 

NFIRST  =  NFIRST  +  1 
GO  TO  13 
10  NFIRST  »  1 

13  NL AST  -  NFIRST  +  NZIK)  -  1 
I F ( L  .EQ.  1)  GO  TO  16 
MFIRST  *  0 

DO  IS  N2-2.L 

MFIRST  »  MFIRST  N2IN2-1) 

15  CONTINUE 
MFIRST  »  MFIRST  +  1 
GO  TO  17 

16  MFIRST  -  1 

17  MLAST  -  MFIRST  +  NZ  <  L  )  -  1 

READ  STIFFNESS  PARTITION  (KFF)  FROM  TAPE. 

NAME  =  K*1000  +  L 

CALL  READTP(STIFF.60*NAME.NSIZE<K;> .NSIZE(L) .b.o.o.kff.ierri 
IF  ( I  ERR  .EQ.  1)  GO  TO  900 

IF  NUMBER  OF  RETAINED  FREEDOMS  “  0.  PLACE  ALL  ELEMENTS  IN  K22 
IFMNZm  .EQ.  0)  .AND.  (NZ(L)  .EQ.  0>>  GO  TO  150 
C  IF  ALL  FREEDOMS  ARE  RETAINED.  PLACE  ALL  ELEMENTS  IN  KU 

IFKNZIK)  .EQ.  ISIZEN)  .AND.  (NZ(L)  .EQ.  ISIZEM))  GO  TO  140 


DO  100  N-l. ISIZEN 
M12  =  NZ ( L ) 

M22  =  NZIL) 

M2 1  =  0 
Mil  =  0 

IF  (NZ(K)  .EQ.  0)  GO  TO  21 

DO  20  NTEST-NFIRST.NLAST 
IF  (NSAVE(NTEST)  .EQ.  N)  GO  TO  50 

20  CONTINUE 

21  CONTINUE 
N21  *  N21+1 
N22  =  N22+1 

DO  40  M-l. ISIZEM 
IF  (NZ(L).EQ.  0)  GO  TO  31 

DO  30  M TEST “MFIRST .MLAST 

IF  ( NSAVEI MTEST )  .EQ.  M)  GO  TO  35 

30  CONTINUE 

31  CONTINUE 

C  PLACE  THE  N.M  ELEMENT  OF  KFF  INTO  THE  K22  PARTITION 
M22  ■  M22+1 

SORTEDIN22.M22)  “  STIFFIN.MI 
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GO  TO  40 
35  CONTINUE 

C  PLACE  THE  N.M  ELEMENT  OF  <FF  INTO  THE  <21  PARTITION 
M2 1  -  M21  +  1 

SORT EDIN21.M21)  -  STIFF (N#M) 

40  CONTINUE 
GO  TO  100 

50  CONTINUE 
Nil  -  Nll  +  1 
N12  ■  N12+1 

00  90  M«1»ISIZEM 
IF  INZIL)  .EO.  0)  GO  TO  71 

DO  70  MTEST-MFIRST.MLAST 

IF  ( NSAVE ( MTEST )  .EO.  M)  GO  TO  75 

70  CONTINUE 

71  CONTINUE 

C  PLACE  THE  N,M  ELEMENT  OF  KFF  INTO  THE  <12  PARTITION 
M12  -  M12+1 

S0RTED(N12#M12)  -  ST  I FF ( N#M ) 

GO  TO  90 
75  CONTINUE 

C  PLACE  THE  N.M  ELEMENT  OF  <FF  INTO  THE  <11  PARTITION 
Mil  =  Mll+1 

S0RTED(N11#M11 )  ■  ST  IFF (N#M ) 

90  CONTINUE 

100  CONTINUE 
GO#TO  160 

C  ALL  FREEDOMS  RETAINED.  ALL  ELEMENTS  OF  <FF  GO  INTO  <11. 

140  CONTINUE 

ISIZEN  =  NSIZEIO 
ISIZEM  -  NSIZE(L) 

NCNT1  -  NCNT1  ♦  1 

CALL  WRTETPISTIFF.60. ID. ISIZEN, ISIZEM, B,0.0.<FF11,IERROR) 

GO  TO  200 

C  NO  RETAINED  FREEDOMS.  ALL  ELEMENTS  OF  <FF  GO  INTO  <22. 

150  CONTINUE 

ISIZEN  -  NSIZEIO 
ISIZEM  »  NSIZEILI 
NCNT 2  ■  NCNT2  ♦  1 

CALL  WRTETP  1ST  IFF, 60,  ID, I  SI  ZEN , I S IZEM  ,  B.NFILE.NMAT  »<FF22» 

*  I  ERROR) 

GO  TO  200 
160  CONTINUE 

C  WRITE  OUT  <22  PARTITION  ONTO  TAPE 
N  -  NZIO  +  1 
M  ■  NZIL)  *  1 
IROW  -  ISIZEN  -  NZIO 
ICOL  -  ISIZEM  -  NZIL) 

IF  1 1 1  ROW  *EO.  0)  .OR.  I ICOL  ,EQ.  0))  GO  TO  170 
WRITE  1 1  OUT ,6500 )  ID , I  ROW , ICOL ,<FF22 
NCNT 2  ■  NCNT2  ♦  1 

CALL  WRTETP  ISORTEDIN.M) ,60,  ID  , I  ROW. ICOL »B»NFILE ,NMAT ,<FF22 
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* .  IERROR ) 

170  CONTINUE 

C  WRITE  OUT  K21  PARTITION  ONTO  TAPE 
I  COL  «  NZ(L) 

IF  ( ( I  ROW  .EQ.  0)  .OR.  ( I COL  .EQ.  0))  00  TO  180 
NCOUNT  »  NCOUNT+1 

CALL  WRTETP  I  SORTED  ( N  *  1 )  »60  ♦  ID  .  I  ROW*  ICOL  »B  »NF  ILE  *NMAT  .KFF21 

**  IERROR) 

180  CONTINUE 

C  WRITE  OUT  K12  PARTITION  ONTO  TAPE 
IROW  -  NZU) 

ICOL  »  ISIZEM  -  NZ(L) 

IF  I ( I  ROW  .EQ.  0)  .OR.  (ICOL  .EO.  0))  GO  TO  190 
NCNT  •  NCNT  «■  1 

CALL  WRTETP < SORTED <1*M) .60. ID. IROW. ICOL .B .0.0. KFF12 » IERROR) 

190  CONTINUE 

C  WRITE  OUT  Kll  PARTITION  ONTO  TAPE 
ICOL  =  NZ(L> 

IF  ((IROW  • EOi  0)  .OR.  (ICOL  .EQ.  0))  GO  TO  200 
NCNT  1  »  NCNT1  1 

CALL  WRTETP  ( SORTED ( 1 ♦ 1 ) .60 .  10  . I  ROW. ICOL .B.NF ILE ,NMAT »KFF1 1 

♦.IERROR) 

200  CONTINUE 

201  CONTINUE 
NPART2(K)  •  NCNT 
NPART(K)  -  NCOUNT 

WRITE  END  OF  FILES  ON  ALL  TAPES  INDICATING  THE  END  OF  A  ROW 
IF  (NCOUNT  .NE.  0)  END  FILE  KFF21 
IF  (NCNT  .NE.  0)  END  FILE  KFF12 
IF  (NCNT1  . NE.  0)  END  FILE  KFF 11 
IF  (NCNT2  .NE.  0)  END  FILE  KFF22 
205  CONTINUE 

REWIND  K.FF22 
REWIND  KFF21 
REWIND  KFF12 
REWIND  KFFU 
RETURN 

900  WRITE  (IOUT.9000) 

9000  FORMAT ( ///48H  ERROR  IN  READ  THE  HFF  TAPE  IN  SUBROUTINE  RFSORT ) 

STOP 

END 
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SUBROUTINE  CONECT 


$ IBFTC  CNCT*  DECK 

SUBROUTINE  CONECT 

COMMON/SORT/  NSAVE (  7000 ) »NZ  <  200 ) *NPART ( 200 ) .NPART2 (200) 
COMMON/TERMS/DUMMY! 6) *NP 

COMMON /T  APES/MT1»MT2*MT3»MT4#MT5#MT6  »MT7  »MT®  »MT9»MT10»MT11 »MT12  * 
«  MT13»MT14*MT15»MT16*MT17 
COMMON/COMS/NS I2E ( 200 ) 

DIMENSION  I  SIZE ( 200 ) »«ISIZEI  200 ) .NPARA! 50 ) »B ( 12  ) »PARA ( 50 ) 
EQUIVALENCE  (PARA#NPARA ) 

I  OUT  *  MT6 
NTAPE4  »  MT4 
NTP11  ■  MT11 
KFF11  ■  MT16 
KFF22  ■  MTX 
<21  -  MT 16 
KFF21  ■  MT2 
KFF12  ■  MT12 

N  -  0 

DO  10  I-l.NP 

I F ( NZ  <  I  )  »EQ.  0)  60  TO  10 
N  -  N+l 

ISIZE(N)  -  NZ(I» 

10  CONTINUE 
NUMBER  *  N 
N  -  0 

C  SET  JSIZE  ARRAY 
DO  20  I “1 *NP 

IF(NZtl)  .EQ.  NSIZE(lt)  60  TO  20 
N  •  N+l 

JSIZE(N)  -  NSIZE(I)  -  NZ!I) 

20  CONTINUE 
NUMB  -  N 

C  WRITE  PARAMETERS  IN  FILE  1  OF  NTAPE4 
REWIND  NTAPE4 
NPARA! 1)  ■  NUMB 
NPARA ( 2 )  ■  2*NUMB 
NPARA ( 3 )  -  NUMBER 
PARA ( 4 )  ■  1.0 
NPARA! 5)  -  NUMBER 
DO  30  I *6.50 
NPARA ( I )  -  0.0 
30  CONTINUE 
NAME  -  0 

CALL  WRTETP ( NPARA #1 .NAME.50.1.6.0.0.NTAPE4* I ERR) 

END  FILE  NTAPE4 
C 

C  EXPAND  KFF11  TAPE  ONTO  TAPE  NTAPE4  (2ND  FILE) 

CALL  EXPAND! ISIZE.NUMBER.KFF11 .NTAPE4) 

END  FILE  NTAPE4 


EXPAND  KFF22  TAPE  ONTO  TAPE  NTP11 
REWIND  NTP11 
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CALL  EXPAND! JS I ZE .NUMB *XFF22 *NTP 11 ) 

END  FILE  NTP11 
REWIND  NTP11 
N  =  0 

C  SET  UP  ARGUMENTS  FOR  EXTRAN 

C  ELIMINATE  ZEROS  FROM  THE  NPART  ARRAY  ONLY  IF  THE  FIRST  NON-ZERO 

C  ELEMENT  IS  NOT  EQUAL  TO  THE  CORRESPONDING  ELEMENT  IN  NPART2 • 

INC  =  0 
NZERO  ■  0 
50  INC  *  INC  ♦  1 

IF<NPART( INC)  .NE.  0)  GO  TO  60 
NZERO  »  NZERO  +  1 
GO  TO  .50 
60  CONTINUE 

IF  I ( NZERO  .NE.  0)  .AND.  (NPARTI INC)  .NE.  NPART2I INC) ) )  GO  TO  110 
DO  70  1*1 .NUMB 
NSUB  =  I  ♦  NZERO 
NPARTI I )  -  NPART ( NSUB ) 

70  CONTINUE 

C  ELIMINATE  ZEROS  FROM  THE  NPART2  ARRAY 
INC  *  0 
NZERO  -  0 
80  INC  =  INC  1 

I F ( NPART2 ( I NC )  .NE.  0)  GO  TO  90 
NZERO  ■  NZERO  ♦  1 
GO  TO  80 
90  CONTINUE 

DO  100  I *1 .NUMBER 

NSUB  »  I  ♦  NZERO 

NPART2 ( I )  ■  NPART2 ( NSUB  ) 

100  CONTINUE 
110  CONTINUE 

CALL  EXTRANINPART.NPART2.NUMBER.NUMB.NTAPE4.K21 .KFF21 .XFF12 ) 

REWIND  NTAPE6 

RETURN 

END 
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SUBROUTINE  EXPAND 


S IBFTC  EXPND*  DECK 

SUBROUTINE  EXPAND ( ISI  ZE  .NUMBER  .KTAPE.ITAPE) 
DIMENSION  TRANSP (60*60) *TEMP (60*60) ♦ISIZE(1)»B(12I 


THIS  SUBROUTINE  EXPANDS  THE  KU  AND  K22  PARTITIONS  ^TO^Ul-L  MATRIX  FORM. 

KTAPE  CONTAINS  INPUT  IN  LOWER  TRIANGULAR  FORM 
ITAPE  CONTAINS  OUTPUT  IN  FULL  FORM 

ITAPE  MUST  BE  POSITIONED  PROPERLY  BY  CALLING  ROUTINE  . 

*#*  NOMENCLATURE  ***  ***  ***  ***  *** 

NROW  -  ROW  OF  PARTITIONS  BEING  FORMED 

ISIZE  ■  ARRAY  CONTAING  SIZES  OF  THE  PARTITIONS 

NROWR  =  ROW  OF  PARTITIONS  IN  WHICH  WE  READ  THE  PARTITION  THAT  WILL  BE 
TRANSPOSED  AND  WRITTEN  IN  THE  PARTITION  ROW  BEING  FORMED 
15  II  fSI  IDENTIFYING  WORD  THAT  IS  ASSCOIATED  WITH  A  GIVEN  PARTITION 
N  *  INDICATES  THE  NUMBER  OF  ROWS  THAT  HAVE  ALREADY  BEEN  FORMED 
NUMBER  -  NUMBER  OF  ROWS  (AND  COLUMNS)  OF  PARTITIONS 


REWIND  KTAPE 
N  -  0 
L  -  0 
NFILE  -  1 
NZERO  -  0 
5  CONTINUE 

IF (N  .NE.  0)  CALL  FSF (N. KTAPE. IERRA) 

NROW  =  N  +  l 
NROWR  *  NROW 

I F ( ISIZE(NROW) »EQ»  0)  GO  TO  40 

READ  ROW  OF  PARTITIONS  AND  ADD  THEM  TO  THE  NEW  TAPE 
DO, 10  1=1. NROW 
NCOL  =  I 
I D  =  0 

CALL  READTP (TEMP .60. ID. I  ROW . 1  COL *B .0 .0 . KTAPE. I  ERROR ) 

I F ( I  ERROR  .NE.  0)  GO  TO  990 

CALL  WRTETP(TEMP .60. ID. I  ROW. I COL. B. 0*0. ITAPE. I  ERR) 

IF  ( I  ERR  .NE.  0)  GO  TO  991 
10  CONTINUE 

IF  (NROW  «GE.  NUMBER)  GO  TO  50 

FORWARD  SPACE  TO  READ  TRANSPOSE  OF  NEXT  PARTITION  TO  BE  WRITEN 
15  CONTINUE 

NROWR  ■  NROWR  ♦  1 

CALL  READTP ( TEMP .60. ID. I  ROW . I COL .B.NFILE  *N .KTAPE. I  ERROR) 

IF ( IERROR  .NE.  0)  GO  TO  990 

FORM  TRANSPOSE 

DO  20  I »1 *  I ROW 
DO  20  J-l.ICOL 
TRANSP ( J  *  I )  -  TEMPI  I .J> 

20  CONTINUE  _  _ 

IDT  -  (10  -  ( ID/1000)*1000)*1000  +  ID/1000 

CALL  WRTETP( TRANSP. 60. IDT . I  COL. I  ROW. B. 0.0. I  TAPE. I  ERR) 

IF  ( I  ERR  .NE.  0)  GO  TO  991 
I F ( NROWR  .GE.  NUMBER)  GO  TO  30 
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GO  TO  15 
30  CONTINUE 

I F ( NROW  *GE •  NUMBER) 
REWIND  KTAPE 
40  N  «  N  +  1 
GO  TO  5 
50  CONTINUE 

REWIND  KTAPE 
RETURN 

990  WR I TE ( 6  *9000 )  I  ERROR 

9000  FORMAT  1 1H1 »23HREADTP 
STOP 

991  WRITE ( 6 • 9001 )  1  ERR 

9001  FORMAT ( 1H1 *2JHWRTETP 
STOP 

END 


GO  TO  50 


ERROR 

ERROR 


IN  EXPAND*  » 13H 

IN  EXPAND*  # 13H 


ERROR  CODE  -,I5) 

ERROR  CODE  »,I5) 
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SUBROUTINE  EXTRAN 


SIBFTC  EXTRN*  DECK 

SUBROUTINE  EXTRAN(NP21.NP12*NPH.NP22.NTAPE4.K21.KFF21.KFF12> 

C  THIS  SUBROUTINE  CREATES  A  FULL  K21  MATRIX  USING  BOTH  K21  AND  K12  TAPES  OUTPUT 
C  FROM  THE  KFSORT  AND  ALSO  A  FULL  K12  MATRIX  (BY  TRANSPOSING  K21). 

c***#  tape  useage  •»***  •***#  ###*  ##»#  #***  #■»*#  ##*#  #### 

C  NTAPE4  IS  THE  OUTPUT  FOR  K21  AND  K12  IN  FULL  FORM.  IT  MUST  BE  POSITIONED  AT 
C  THE  BEGINING  OF  FILE  3  AT  THE  START  OF  THIS  ROUTINE  AND  K12  WILL  BE  WRITTEN 
C  AS  FILE  3  WITH  K21  FOLLOWING  IN  FILE  4. 

C***#  NOMENCLATURE  **♦*  ###*  #***  *#**  #**#  *###  »*»*  **** 

C  NP21  ■  ARRAY  GIVING  THE  NUMBER  OF  PARTITIONS  IN  EACH  ROW  OF  K21 

C  NP12  -  ARRAY  GIVING  THE  NUMBER  OF  PARTITIONS  IN  EACH  ROW  OF  K12 

C  NP 11  -  NUMBER  OF  PARTITIONS  IN  Kll 

C  NP22  -  NUMBER  OF  PARTITIONS  IN  K22 

C  N  -  NUMBER  OF  ROWS  OF  PARTITIONS  WRITTEN  ON  K21 

C  M  «  NUMBER  OF  ROWS  OF  PARTITIONS  WRITTEN  FOR  K12  (ON  NTAPE4 ) 

C  NMOD  -  NUMBER  OF  ROWS  OF  PARTITIONS  READ  FROM  KFF21 

DIMENSION  TEMP ( 60*60 ) uTRANSP (60*60) * B< 1 2 ) #NP21 ( 1 ) *NPX2( 1 ) 

I  ERR  -  0 
I  OUT  *  6 
REWIND  K2 1 
REWIND  KFF21 
REWIND  KFF12 
N  -  0 
NMOD  ■  0 

5  CONTINUE 
AREA  ■=  0.0 

IF  (NMOD  .GT.  0)  CALL  FSF (NMOD.KFF21 *IERR) 

IF  ((NMOD  .GT.  0)  .AND.  ( IERR  .NE.  0>)  GO  TO  992 
NPART  -  NP2KN+1) 

IF  (NPART  .EQ.  0)  GO  TO  12 

C  COPY  NPART  PARTITIONS  FROM  KFF21  TAPE  TO  K21  TAPE 
DO  10  1-1. NPART 
ID  -  0 

AREA  ■  1.0 

CALL  READTP ( TEMP .60.ID.I ROW » ICOL *B .0 *0 . XFF2X . IERR ) 

IF  (IERR  .NE.  0)  GO  TO  990 
AREA  ■  2.0 

CALL  WRTETP(TEMP*60.ID*IROW.ICOL.B»0»O.K21.IERR) 

IF  (IERR  .NE.  0)  GO  TO  990 
XO  CONTINUE 

NMOD  -  NMOD  +  X 
12  CONTINUE 

IF  (NPART  .GE.  NP11)  GO  TO  25 
C  SKIP  NSKIP  ROWS  OF  PARTITIONS  ON  KFF12  TAPE 
NSKIP  -  NPART  -  1 

IF  (NSKIP  .GT.  0)  CALL  FSF ( NSK IP *KFF 12 . I  ERR ) 

AREA  -  3.0 

IF  ((NSKIP  .GT.  0)  .AND.  (IERR  .NE.  0))  GO  TO  992 
NFILE  «  1 

IF  (NSKIP  .LT.  0)  NFILE  -  0 
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NSTART  *  NPART  +  1 
DO  20  I-NSTART.NP11 
ID  -  0 

AREA  *  4.0 

CALL  READTP(TEMP»60*ID#I ROW • I  COL  *B»NFILE«N»KFF12*IERR) 
IF  ( I  ERR  .NE.  0)  GO  TO  990 

c  form  transpose 

DO  15  J  =  l# I  ROW 
DO  15  K*1  * ICOL 
TRANSPUT)  -  TEMP  ( J  »K ) 

15  CONTINUE 

C  WRITE  OUT  ON  TAPE  K21 

IDT  =  (ID  -  ( ID/1000)*1000)*1000  +  ID/1000 
AREA  ■  5.0 

CALL  WRTETP(TRANSP»60# IDT#  ICOL » I  ROW » B »0 »0 » K21 *  I  ERR) 

IF  ( I  ERR  .NE.  0)  GO  TO  990 
NFILE  -  1 
20  CONTINUE 


C  UPDATE  COUNT  OF  ROWS  ALREADY  FORMED 
25  CONTINUE 
N*=N+ 1 

REWIND  KFF21 
REWIND  KFF12 
END  FILE  K21 

IF  (N  *GE»  NP22 )  GO  TO  30 
GO  TO  5 

C  K21  COMPLETED 
30  CONTINUE 
REWIND  K2 1 

C  FORM  K.  1 2  ON  TAPE  4 
M  *  0 

32  CONTINUE 
NFILE  ■  0 

DO  40  1*1 #NP22 
ID  =  0 

AREA  ■  6.0 

CALL  READTP(TEMP»60#ID* I  ROW • ICOL  »B#NFILE»M.K21tIERR) 

IF  ( I  ERR  .NE.  0)  GO  TO  990 

C  FORM  TRANSPOSE 

DO  35  J» 1 • I  ROW 
DO  35  K* 1 • ICOL 
TRANSP(IC#J)  ■  TEMPU.K) 

35  CONTINUE 

IDT  *  (ID  -  ( ID/1000)*1000)*1000  +  ID/1000 
AREA  =  7,0 

CALL  WRTETP(TRANSP*60*IDT  # I  COL . I  ROW ,B»0»0,NTAPE4.IERR) 
IF  ( I  ERR  .NE.  0)  GO  TO  990 
NFILE  -1 
40  CONTINUE 

M  -  M  +  l 

IF  (M  .GE.  NP1 1 )  GO  TO  50 
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REWIND  K21 
GO  TO  32 


C  K12  COMPLETED 
30  CONTINUE 
REWIND  K21 
END  FILE  NTAPE4 


C  WRITE  K21  ONTO  NTAPE4 
DO  60  I*1.NP22 
DO  55  1 »NP 1 1 

ID  -  0 

AREA  -  8.0 

CALL  READTP(TEMP»60#ID*I ROW # I  COL »B»0»0*K21«IERR) 

IF  ( I  ERR  *NE.  0)  GO  TO  990 
AREA  -  9.0 

CALL  WRTETP(TEMP#60»ID* I  ROW  * ICOL#B*0»0»NTAPE4 » I  ERR ) 
IF  ( I  ERR  *NE*  0)  GO  TO  990 
55  CONTINUE 

IF  II  .LT.  NP22 )  CALL  FSF ( 1 *K2 1  *  I  ERR ) 

IF  (II  .LT*  NP22 )  .AND.  ( IERR  .NE.  0))  GO  TO  992 
60  CONTINUE 

C  NTAPE4  COMPLETED 

END  FILE  NTAPE4 
REWIND  K21 
RETURN 

C  ERROR  COMMENTS 

990  WRITE  (6.9000)  AREA 1 1  ERR 
STOP 

992  WRITE  16*9002)  AREA. IERR 
STOP 

9000  FORMAT!//  7H  AREA  ■*F3.0*10X.13HERRROR  CODE  -  15) 

9002  FORMAT <//18H  FSF  ERROR.  AREA  •.F5.0.13H  ERROR  CODE  «. 
END 
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SUBROUTINE  DELETE 


SIBFTC  DELET*  DECK 

SUBROUTINE  DELETE < I  TYPE .NELEM.NSTRS ) 

COMMON/ TAPES/MTl .MT2.MT3.MT4.MT5.MT6.MT7.MT8.MT9.MT10.MT11.MT12. 
#  MT13.MT14.MT15.MT16.MT17 
COMMON/TERMS/NBEAM.NPLATE  *NN0DE  .NCOND.NPS.NTOL  *NP 
COMMON /RS I ZE/ ISIZEI500) .NROW • JSI ZE ( 200 ) 

COMMON/L ASTND/LN (200) 

COMMON /M APS TR/ IPTOT#IBTOT 
COMMON/ TEMPO/STRESS (96 *60) 

DIMENSION  SAVE ( 96 ) • I C ( 60 ) 


C  THIS  SUBROUTINE  DELETES  THE  COLUMNS  OF  THE  STRESS  MATRIX  THAT  CORRESPOND  TO 
C  CONSTRAINED  DEGREES  OF  FREEDOM 


###* 


**#* 


*»#* 


#**#  **** 

TYPE  OF  ELEMENT  IN  STRESS  MATRIX.  1  FOR  BEAMS.  0  FOR  PLATES 
THE  MAXIMUM  NUMBER  OF  ELEMENTS  PER  PARTITION 
THE  NUMBER  OF  STRESSES  PER  ELEMENT 

THE  ARRAY  OF  ROW  DIMENSIONS  FOR  THE  STRESS  PARTITIONS 
NROW  ■  NUMBER  OF  ROWS  OF  PARTITIONS  IN  STRESS  MATRIX  BEING  PROCESSED 
JSIZE  ■  COLUMN  DIMENSIONS  FOR  STRESS  PARTITIONS  (SORTED) 


****  NOMENCLATURE  **** 
I  TYPE 
NELEM 
NSTRS 
ISIZE 


*#** 


***# 


**** 


NSTRES  =  MT 1 2 
KSTRES  =  MT  8 
I KBC  =  MT3 
I  OUT  =  MT6 
REWIND  NSTRES 


CALCULATE  PARTITION  COLUMN  SIZE  ARRAY 
DO  10  I = 1 *NP 
I F ( I  .EQ.  1)  GO  TO  5 


10 


JS IZE ( I ) 
GO  TO  10 
CONTINUE 
JS I ZE ( I ) 
CONTINUE 


1  ( LN (  1  )  -  LN< I  —  1 )  1*6 


=  LN<  I  )  *6 


IF  ( I  TYPE  .EQ.  1)  NUMBER  »  NBEAM 
IF  ( I  TYPE  .EQ.  0)  NUMBER  -  NPLATE 
I F ( I  TYPE  .EQ.  II  NTOT  -  IBTOT 
I F ( I  TYPE  .EQ.  0)  NTOT  ■  IPTOT 
NTOT 2  -  NTOT 
IREM  =  0 


CALCULATE  NUMBER  OF  ROWS  OF  PARTITIONS  AND  ROW  DIMENSIONS 
NROW  =  NUMBER/NELEM 

IF  (NUMBER  -  NROW*NELEM  .EQ.  0)  GO  TO  15 
NROW  -  NROW  +  1 
IREM  «  1 

15  DO  20  1*1 .NROW 

ISIZE ( I )  *  NELEM*NSTRS 
20  CONTINUE 

IF  (IREM  .EQ.  1)  ISIZE(NROW)  -(NUMBER  -  (NROW  -  1 ) *NELEM I *NSTRS 
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C  BEGIN  SORTING  PROCESS 


NCOUNT  =  0 

C  LOOP  ON  PARTITION  ROWS 
DO  200  I  *  1  * NROW 
REWIND  I  ICBC 

C  LOOP  ON  PARTITION  COLUMNS 
DO  190  J=1 #NP 
IMAX  -  ISIZEII) 

DO  25  I2=1»IMAX 
DO  25  J2* 1 • 60 
STRESS (  I  2  •  J2 )  -  0.0 
25  CONTINUE 

ID  -  1000*1  +  J 

I F ( NCOUNT  .GE.  NTOT )  GO  TO  210 
READ  ( KSTRES )  NCODE 

C  READ  IN  BOUNDARY  CONDITIONS  FROM  IKBC 
IF  (J  .EQ.  1)  GO  TO  32 
N 1  «  LN(J-l)  +  1 
N2  -  LN(J) 

GO  TO  33 

32  CONTINUE 
N1  -  1 

N2  =  LN(J) 

33  CONTINUE 
M  «  1 

DO  35  NN-N1.N2 

READ  ( IKBC)  NODE • I JKLMN 

IF  (NODE  «NE.  NN)  GO  TO  990 

CALL  UNPACK! I JKLMN  t I C ( M ) , IC(M+1 ) *IC(M+2 ) *IC(M+3 ) »IC(M+4) . IC(M+5> ) 

ISP  »  0 

M6  =>  M+5 

DO  34  IT-M.M6 

IF(IC(IT)  .EQ.  3)  ISP  ■  1 

34  CONTINUE 

IFtlSP  .EQ.  1)  READ ( 1 KBC )  D1 #D2 . 03 »D4*D5 »D6 
M  -  M  +  6 

35  CONTINUE 

IF  (NCODE  .NE.  ID)  GO  TO  180 

C  SORT  THIS  PARTITION  (NCODE  ■  ID) 

NCOUNT  -  NCOUNT  +  1 

C  READ  IN  STRESS  PARTITION  FROM  KSTRES 
IROW  «  I  SIZE  < I ) 

ICOL  ■  JSIZE(J) 

READ  (KSTRES)  (( STRESS ( M . N ) *M« 1 . IROW ) »N» 1 » I  COL ) 

ICON  =  0 

C  COUNT  FREEDOMS  TO  BE  DELETED 
DO  40  NN-1'ICOL 

I F ( ( I C ( NN )  .EQ.  1)  .OR.  (IC(NN)  .EQ.  2))  ICON  -  ICON  +  1 
40  CONTINUE 


C  TEST  FOR  NO  CONSTRAINED  FREEDOMS  OR  FOR  ALL  CONSTRAINED  FREEDOMS 
IF  ( ICON  .EO.  0)  GO  TO  120 
I F ( I  CON  .EO.  ICOL)  NT0T2  »  NT0T2  -  1 
IF  (ICON  .EO.  ICOL)  GO  TO  190 


C  BEGIN  SORTING 
JS  =  0 
JS1  =>  0 
JS2  =  0 
50  JS  =  JS  +  1 

IFI(ICUS)  »NE.  1)  .AND.  (IC(JS)  .NE.  2))  GO  TO  100 

C  DELETE  THIS  COLUMN 
N 1  =  JS1  +  2 
N2  =  ICOL 
DO  66  JNC1*N1.N2 
DO  65  INCl-l.IMAX 

STRESS! INC1 .JNCl-1 )  =  STRESS ( I NC 1 »JNC1 ) 

65  CONTINUE 

66  CONTINUE 

IF  (JS  .LT.  ICOL)  GO  TO  50 
100  CONTINUE 

C  UPDATE  COUNT  OF  RETAINED  COLUMNS 
JS1  “  JS1  +  1 

IF  (JS  .LT.  ICOL)  GO  TO  50 

C  WRITE  OUT  THE  NEW  PARTITION  ON  TAPE  NSTRES 
WRITE! NSTRES )  NCODE 

WRITE (NSTRES) (  ( STRESS (M.N) »M* 1,1  ROW)  .N-1.N2) 

GO  TO  190 

120  CONTINUE 


C  ALL  FREEDOMS  RETAINED.  NO  SORTING  NEEDED 
WRITE! NSTRES )  NCODE 

WRITE (NSTRES)  ( ( STR ESS ( M » N ) , M» 1 , 1  ROW ) ,N- 1 , 1  COL ) 
GO  TO  190 
180  CONTINUE 

BACKSPACE  KSTRES 
190  CONTINUE 

200  CONTINUE 

210  CONTINUE 

I F ( I  TYPE  .EQ.  0)  I P  TOT  =  NT0T2 
I F ( I  TYPE  .EO.  1)  IBTOT  ■  NT0T2 
REWIND  I KBC 
REWIND  NSTRES 
RETURN 


C  ERROR  COMMENT 

990  WRITE  ( I  OUT , 9000 )  NODElNN 
STOP 
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9000  FORMAT ( //87H  NODE  NUMBER  READ  FROM  TAPE  IN  SUBROUTINE  DELETE  DOES 
#NOT  AGREE  WITH  WHAT  WAS  EXPECTED./  6H  READ  .I8.5X.10H  EXPECTED  18) 
END 
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SUBROUTINE  SSORT 


SIBFTC  SSORT*  DECK. 

SUBROUTINE  SSORT ( I T YPE * NELEM *NSTRS ) 

COMMON /SORT /NSAVEI7000) *NZ ( 200 ) »NPART(200) 

COMMON / T AP ES /MT 1 *MT 2  *MT  3  *MT4  *MT5  *MT6 *MT7  *MT8*MT9*MT10*MT11*MT12* 

*  MT13*MT14*MT15*MT16*MT17 
COMMON/ TERMS/NBEAM. NPLATE  »NNQDE  *NCOND *NPS  *NTOL  *NP 
COMMON/RS I ZE/ ISIZEI500) .NROW * JS I ZE ( 200 ) 

COMMON /COM 5/ NS  1 ZE ( 200 ) 

COMMON /MAPSTR/ IP  TOT *IBTOT 
COMMON/ TEMPO/ STRESS (96 *60) 

DIMENSION  SAVE ( 96 ) • NP AR A ( 50 ) • P AR A ( 50 ) *  SORT  EDI 96*60)*B(12) 
EQUIVALENCE! STRESS  *  SORTED ) ( ( NPARA  *P  ARA ) 

THIS  SUBROUTINE  SORTS  THE  STRESS  MATRIX  FOR  EITHER  BEAMS  OR  PLATES  INTO 
PARTS  -  SI  (RETAINED)  AND  S2  (REDUCED) 

•••••NOMENCLATURE***** 

ITYPE  ■  TYPE  OF  STRESS  MATRIX.  1  FOR  BEAMS*  0  FOR  PLATES 
NELEM  ■  THE  MAXIMUM  NUMBER  OF  ELEMENTS  PER  PARTITION 
NSTRS  *  THE  NUMBER  OF  STRESSES  PER  ELEMENT 

NS  I ZE  ■  ARRAY  OF  COLUMN  DIMENSION  FOR  THE  STRESS  PARTITIONS 
I  OUT  =  MT6 
KSTRES  =  MT 12 
KS2  =  MT 16 


TWO 


I F ( ITYPE 
I  F ( ITYPE 
I F ( ITYPE 
I F ( ITYPE 


•  EQ. 
.EQ. 

•  EQ. 
.EQ. 


1  ) 
0) 
1  ) 
0) 


c  CALCULATE  NUMBER  OF 


NTOT  = 
NT  OT  = 
NUMBER 
NUMBER 
ROWS  OF 


IBTOT 
IPTOT 
=  NBEAM 
=  NPLATE 
PARTITIONS 


AND  ROW  DIMENSIONS 


NSTAPE  =  MT  3 

IF  (ITYPE  .EQ.  0)  NSTAPE  =  MT1 
REWIND  NSTAPE 
REWIND  KS2 


C 


COUNT  NUMBER  OF  SI 
NS  1  =  0 
NS2  =  0 
DO  4  I»1*NP 
IF  (NZ(I)  .NE. 
IF  ( NZ ( I )  .NE. 
4  CONTINUE 


AND  S2  PARTITIONS 


0)  NS  1  =  NS1  ■*■  1 
NSIZEt I ) )  NS2  ■  NS2  +  1 


C  SET  PARAMETER  MATRIX  AND  WRITE  OUT  AS  FIRST  FILE  OF  TAPE  NSB  OR  NSP 
NPARA ( 1 )  =  NS2 
NPARA ( 2 )  =  2*NS2 
NPARA ( 3 )  =  NS1 
PARA ( 4 )  =  1.0 
NPARA15)  =  NROW 
DO  6  I  =6*50 
6  NPARA! I )  »  0.0 
NAME  »  0 

CALL  WRTETP ( NPARA  *1 .NAME  *50  *1*B*0*0*NSTAPE*I ERROR ) 

END  FILE  NSTAPE 
NCOUNT  =  0 


C  LOOP  ON  PARTITION  ROWS 
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DO  200  1=1 *NROW 
C  LOOP  ON  PARTITION  COLUMNS 
DO  190  J  =  1  * NP 
IMAX  =  I S I ZE ( I ) 

DO  5  I NC= 1 1 1  MAX 
DO  5  JNC=1 • 60 
STRESS! INC.JNC)  =  0.0 
5  CONTINUE 

ID  =  1000*1  +  J 

I F ( NCOUNT  .GE.  NTOT )  GO  TO  150 
READ  ( KSTRES )  NCODE 
IF  (NCODE  .NE.  ID)  GO  TO  150 
C  THIS  PARTITION  IS  TO  BE  SORTED  BY  COLUMNS. 

NCOUNT  =  NCOUNT  +  1 
JS1  =  0 
JS2  =  NZ(J) 

C  CALCULATE  LOCATION  OF  RETAINED  FREEDOMS  FOR  THIS  PARTITION 
IF  (J  .EQ.  1)  GO  TO  20 
NFIRST  =  0 
DO  15  Nl  =  2  * J 

NFIRST  =  NFIRST  +  NZ(Nl-l) 

15  CONTINUE 

NFIRST  =  NFIRST  4  1 
GO  TO  23 
20  CONTINUE 
NFIRST  =  1 
23  CONTINUE 

NLAST  -  NFIRST  +  NZ!J)  -  1 
C  READ  STRESS  PARTITION  FROM  TAPE 
IROW  =  I  SIZE ( I ) 

ICOL  =  NSIZE(J) 

READ  ( KSTRES )  < ( STRESS < I S . JS ) . I S« 1 . 1  ROW ) . JS»1 , I  COL ) 

C  IF  NO  FREEDOMS  ARE  RETAINED*  PLACE  ELEMENTS  IN  S2. 

IF  ( NZ ( J )  .EQ.  0)  GO  TO  100 
C  IF  ALL  FREEDOMS  ARE  RETAINED.  PLACE  ELEMENTS  IN  SI 
IF  ( NZ ( J )  .EQ.  NSIZE(JJ)  GO  TO  90 

C  BEGIN  SORTING  LOOP 
JS  =  0 
JS1  =  0 
JS2  =  0 

30  JS  *  JS  +  1 

DO  40  NTEST-NFIRST.NLAST 
IF  ( NSAVE ( NTEST )  .EQ.  JS)  GO  TO  60 
40  CONTINUE 
C  PLACE  COLUMN  IN  S2 
JS2  *  JS2  4  1 
N 1  =  JS1  *  1 
DO  50  IS2=1 .IROW 
SAVE! IS2)  -  STRESS! IS2.N1) 

50  CONTINUE 
N2  ■  NZ ( J ) 

N3  =  NZ ( J )  +  JS2 
N4  =  JS1  +  2 

DO  56  JNC1-N4.N2 
DO  55  INC1-1.IMAX 

STRESS! INC1 .JNC1-1 )  -  STRESS < I NC 1 .JNC1 ) 

55  CONTINUE 
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56  CONTINUE 


DO  57  INC1*1#IMAX 

STRESS! INC1 »N2 )  ■  STRESS l INC1 #N3 ) 

57  CONTINUE 

DO  58  I NC2* 1 »  I  MAX 

STRESS ( I NC2  » N3  )  -  SAVE ( I NC2 ) 

58  CONTINUE 

GO  TO  70 

60  CONTINUE 
C  PLACE  COLUMN  IN  SI 
JS1  *  JS1  +  1 

70  CONTINUE 

IF  US  «  LT  .  NSAVE ( NLAST ) )  GO  TO  30 
GO  TO  120 

C  ALL  FREEDOMS  RETAINED.  PLACE  ALL  COLUMNS  IN  THE  SI  PART 
90  CONTINUE 

CALL  WRTETP (STRESS #96  # ID# I  ROW# I  COL  #  8 #0 » 0  #NSTAPE  » I  ERROR ) 

♦INTO  SI) 

GO  TO  190 

C  NO  RETAINED  FREEDOMS.  PLACE  ALL  COLUMNS  IN  THE  S2  PART. 

100  CONTINUE 

CALL  WRTETP (STRESS# 96 #ID# I  ROW# I COL  »  B»0»0#XS2  » I  ERROR ) 

GO  TO  190 

C  WRITE  OUT  SI  AND  S2  PARTS 
120  CONTINUE 

IROW  =  I  SI Z  E ( I  ) 

ICOL  =  NZU) 

J1  =  NZ(J)  +  1 

CALL  WRTETP (STRESS ( 1 #1 ) #96  # ID# IROW# I  COL t B » 0 .0 *NST APE • I  ERROR ) 
ICOL  =  NSIZEU)  -  NZU) 

CALL  WRTETP ( STRESS ( 1.J1 ) » 96 • I D # I  ROW . ICOL # B #0 # 0 » KS2  » I  ERROR ) 

GO  TO  190 

C  WRITE  NULL  PARTITIONS  FOR  SI  AND  S2  ONTO  TAPE 
150  CONTINUE 

IROW  =  I  SIZE ( I  ) 

ICOL  =  NZU) 

IF  (NZU)  .EQ.  0)  GO  TO  160 

CALL  WRTETP (STRESS #96  # ID# IROW# ICOL  »  B #0 « 0  # NST APE • I  ERROR ) 

160  CONTINUE 

IF  ( NZ  <  J )  .EQ.  NSIZEU))  GO  TO  170 
ICOL  =  NSIZEU)  -  NZ  (  J  ) 

CALL  WRTETP ( STRESS# 96 # ID# IROW# ICOL# B #0*0 »XS2# I  ERROR ) 

170  CONTINUE 

BACKSPACE  KSTRES 
190  CONTINUE 
200  CONTINUE 

REWIND  KS2 
END  FILE  NSTAPE 

C  COPY  S2  FROM  KS2  TO  FILE  3  OF  NSTAPE 
DO  300  1=1. NROW 
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DO  300  J«1#NS2 
ID  =  0 

CALL  READTPt STRESS #96# ID* IROW# ICOL#B#0#0#KS2# IERR ) 

CALL  WRTETP ( STRESS  #96 • I D# I  ROW# I COL  #B#0#0#NSTAPE#I ERROR ) 
300  CONTINUE 

END  FILE  NS TAPE 
REWIND  NSTAPE 
REWIND  KS2 
RETURN 


END 


377 


nftnnnnn 


SUBROUTINE  FREMOD 


SIBFTC  FREMO*  DECK 

SUBROUTINE  FREMOD 

FORMULA  NUMBERS  1  TO 
FORMULA  NUMBERS  6000 
FORMULA  NUMBER  7500 
FORMULA  NUMBERS  8000 
FORMULA  NUMBERS  9000 


5999  ARE  NORMAL  PROGRAM 
TO  7499  ARE  DIAGNOSTICS 
S  THE  CALL  EXIT  STATEMENT 
TO  8999  ARE  INPUT  FORMATS 
TO  9999  ARE  OUTPUT  FORMATS 


C 


C 


c 

c 


c 

c 

c 


c 

c 

c 

c 


DIMENSION  DYNMAT(100*100)  »  AMASSdOO).  CURNTD  (  100  *  1 00  )  . 

1CMATI 100.3) .  FLEXIBI 100*100) .  GUESSdOO).  TEMPl(lOO)*  VECMAT ( 
225)*  TEMPdOOJ#  TEMPRYdOO).  TMPRYI100.3).  DIAGdOO).  B(12). 
3N0RMEL ( 25 ) i  FREQ ( 25 ) <  ITER<25).  PCTB IG( 25 ) .  CTMC(3.3>.  NTAPE ( 
4BMASS(100).EVAL<100) 


100. 

10)  • 


EQUIVALENCE  < DYNMAT . FLEX  I B .CURNTD . BMASS )»< AMASS . VECMAT ) . 

1 ( DI FF  » ID  IFF ) *  ( I ERNOW  *  ERRNOW  )  »  ( ERROR . I  ERR ) »  ( ERLGST . IERLG )  • 

2  ( DIFSML# IDFSML ) .  ( TMPR Y (1 . 1 )  . TEMP )  . 

3(TMPRY(1#2) .TEMPRY) »(TMPRY< 1 .3) .TEMPI) 


INTEGER  T6.T5 
T5  »  5 
T  6  =6 
I  TP=  0 

PCTLMT-10.0 
MAXITR-1500 
NTAPED-3 
SF* 1 »  0 

10  READ  IT5.8000)  N.  MODES 

140  DO  145  I-l.N 
AMASS ( I )  »  0.0 
DO  145  J-l.N 
FLEX  I B  (  I  .J)  ■  0.0 
145  CONTINUE 


READ  FLEXIBILITY  MATRIX 


150  NSTART-0 
NEND=0 

NSTART-NEND-t-1 
ITEMP  -  10 
I  PART* 1 
NAME=0 
NFILE=0 
NMAT  -  1 

175  REWIND  ITEMP 

CALL  READTPIFLEXIB(NSTART.NSTART) *  100 .NAME .K »K »B ,NF I LE  .NMAT  ,  I  TEMP 
l.IRR) 

I F ( I RR . NE . 0 ) GO  TO  6015 
225  NEND-NEND+K 

READ  DIAGONAL  MASS  MATRIX 

READ  ITS. 8005 )  (AMASS! I ) .I*NSTART .NEND) 
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<►50  WR ITE  (  T6  *9000  )  SF 
00  475  I  =  1  #N 

475  WRITE (T6* 9005 ) I • ( FLEX  IB (I#J)#J«1»N) 
scale  flexibility  matrix 

495  DO  500  I  -  1  #  N 
DO  500  J»1#N 

500  FLEX  I B ( I »J)=FLEXIB( I *J)*SF 

FORM  DYNAMIC  MATRIX  FROM  FLEX  I B  AND  AMASS 

DO  550  I  =  1  #N 
DO  550  J  »  1 #N 

550  DYNMAT (  I  » J  )  *  FLEX  I B ( I # J ) *AMASS< J ) 

PUT  ORIGINAL  DYNAMIC  MATRIX  ON  SCRATCH  TAPE 

551  REWIND  NTAPED 

CALL  WRTETP (DYNMAT# 100 »0»N#N#B#0»0#NTAPED# I RR ) 

I F ( IRR.NE.O)  GO  TO  6055 
575  WRITE(T6*9010) 

DO  600  I-1#N 

600  WR I TE  <  T6  #9005 ) I #( DYNMAT ( I  * J ) #J«1»N) 

WRITE  OUT  MASS  MATRIX 

605  WRITE(6#9015 )  ( I • AMASS ( I) *  I “1 #N ) 

CALL  WRTETP ( AMASS #1*0#1#N#B»0#0#NTAPED# I RR) 

I F ( IRR#NE#0) GO  TO  6040 
ENDFILE  NTAPED 
REWIND  NTAPED 

GET  VALUES  AND  VECTORS# 

CALL  VALVCTI DYNMAT » N » MODES # EVAL #VECMAT ) 

LOOP  TO  EXAMINE  ROOTS  1  BY  1 


REWIND  NTAPED  , 

CALL  READTP (DYNMAT #100 #0#N#N#B#0#0 #NTAPED» I RR ) 

IF  ( IRR.NE.O)  GO  TO  6060 
DO  1350  MODE-1 #MODES 

FORM  D  V  AND  EVAL  V  TO  SEE  IF  THIS  MODE  IS  A 
GOOD  ONE. 


1175 


1200 

1225 

1250 

1260 

1265 


DIFSML-1.0E38 


0  1250  I  - 1 #N 

F  ( ABS(VECMAT( I .MODE )  -  0. 0 1 )) 1250 • 1 175 • 1 175 
EMPRY ( I )  ■  EVAL ( MODE ) *VECMAT ( I .MODE ) 

ALL  I NRPRD (  DYNMAT ( I » 1 ) # 100 » VECMAT ( 1 »MODE ) » 1 #TEMP ( I ) #N  ) 

i iff  -  ABS(TEMP(I)-TEMPRY(I))*2.0/(ABS(TEMP(I)+TEMPRY(I))) 

F  ( IDFSML-IDIFF)  1250# 1250  » 1225 
iIFSML-DIFF 


CONTINUE 

PCTBIG(MODE) -( 1 .0-D I FSML ) *100 .0 
IF(PCTBIG(MODE) .GE. 0.0)60  TO  1270 
PCTBIG ( MODE ) “  0.0 


IS  THE  BEST  PERCENTAGE  GOOD  ENOUGH 


379 


c 

1270  IF  (PCTBIG1M0DE )-PCTLMT )  1275*1325*1325 
C 

C  THIS  MODE  SHAPE  IS  NO  GOOD*  PRINT  OUT  ERROR 

C 

1275  WR  I  TE(T6 *9055) MODE *PCTBIG (MODE ) *PCTLMT. (TEMPRYU ) • I  *  TEMP (  I ) • I-l.N) 
C 

C  MODE  IS  FOUND  CORRECTLY  -ARE  MORE  REQUESTED 

C 

1325  IF  (EVAHMODEl.LT. 0.0)  GO  TO  6500 
IF(EVAL(MODE)*EQ.O.O)GO  TO  1330 
EVAL(MODE)-SQRT(1.0/EVAL(MODE) ) 

1330  FREQ ( MODE )«EVAL< MODE ) /6 .2831 8530 
1350  CONTINUE 
C 

C  ALL  DONE  WITH  FINDING  VECTORS. FORM  ORTHOGONALITY 

C  MATRIX  VT  M  V 

C 

TMINDG-1.0E38 

TMAXDG--TMINDG 

tmaxod=tmaxdg 

CALL  READTP(BMASS.1*0.NR*NC*B.0.0.NTAPED.IRR) 

IF  ( IRR  »NE .  0 )  GO  TO  6066 
WR I TE ( T6  ♦  9001 ) 

DO  1400  1*1 .MODES 
DO  1360  J  »  1  * N 

1360  TEMP  1 ( J )  =  VECMAT ( J  *  I ) *BM ASS ( J ) 

DO  1375  J-l. MODES 

1375  CALL  INRPRD  (TEMPI  *  1  * VECMAT ( 1 »J )* 1  *  TEMP ( J ) *N ) 

C 

C  PRINT  VT  M  V  -  ONE  ROW 

C 

WR I TE ( T6  *9065 ) I  * ( TEMP ( J ) * J- 1 *MODES ) 

TEMPRY ( I ) “TEMP ( I ) 

DO  1400  J-1. MODES 
IF  (I-J)  1380.1385*1380 
1380  TMAX0D*AMAX1TABS(TEMP(J) ) .TMAXOD ) 

GO  TO  1400 

1385  TMAXDG-AMAXKTEMP(J)  .TMAXDG) 

TMI NDG-AMINH TEMPI J) .TMINDG) 

1400  CONTINUE 

WR  I TE(T6* 9060) TMAXDG. TMINDG .TMAXOD 
C 

C  PRINT  INERTIA  MATRIX 

C 

WR I TE  <  T6  * 9070  > ( I .TEMPRY ( I ) *1-1 .MODES) 

C 

C  PRINT  MODE  SHAPES 

C 

K  =MODES 

Kl-1 

K2-6 

IF  (K-6)  1430.1435*1435 

1430  K2-MODES 
1435  WRITE(T6.9075)K1.K2 
DO  1440  I-l.N 

1440  WR I TE ( T6 .9076 ) ( I .VECMAT ( I .J) .J-K1.K2) 

K-K-6 

IF  U)  1550.1550.1450 
1450  Kl-K.2  +  1 


380 


n  n  r>  r>  n  r»  non  n  n  n  n  non 


IF  (X-6)  1430* 1430* 1525 
152  5  K2-K1+5 

GO  TO  1435 

WRITE  OUT  TABLE  OF  RESULTS 

1550  WR I TE ( T6  *9080 ) ( I »EVAL( I ) • FREQ ( I ) »PCTBIG( I ) » I » I “1 *M0DES) 


WRITE  RESULTS  ON  TAPE  IF  DESIRED 


1575  NTAPOT  =  10 
NAME=0 
NFILE  «  2 

nmat«o 

WRITE  FREQUENCIES*  MODE  SHAPES*  INERTIA  MATRIX*  AND  MASS  MATRIX* 


CALL  WRTETP  (FREQ*1 * NAME* MODES *1 *B*NFILE  *NMAT  * NTAPOT* IRR ) 
I F { I RR *NE*0 ) GO  TO  6030 

1600  CALL  WRTETP ( VECMAT  *  100 *NAME+1 *N »MODES*  B  *0  *0*NTAP0T  *  I  RR) 
IF!  IRR.NE.OIGO  TO  6030 


CALL  WRTETP ( TEMPRY *  1  * NAME+2  *  1 » MODES » B*0 *0 • NTAPOT • IRR ) 
IF< IRR.NE.OIGO  TO  6030 
END  FILE  NTAPOT 

CALL  WRTETP! BMASS*1 *NAME+3*1 *N*B *0*0 *NTAPOT * IRR I 

IF! IRR.NE.OIGO  TO  6030 
END  FILE  NTAPOT 


1640  GO  TO  7500 

THE  FOLLOWING  ARE  ALL  DIAGNOSTIC  PRINT  EXITS 

6015  WR ITE!T6*9100) 

6016  NTAPDG-ITEMP 
GO  TO  7000 

6030  WRITE!T6*9115)NFI LE *NMAT 
NTAPDG=NTAPOT 
GO  TO  7000 
6040  WRITE!T6*9210) 

NTAPDG-NTAPED 
GO  TO  7000 

6055  WRITE  <T6*9200> 

6056  NTAPDG  =  NTAPED 
GO  TO  7000 

6060  WRITE  t  T6 * 9205 ) 

GO  TO  6056 

6066  WRITE  «T6*9215) 

GO  TO  6056 

7000  WRITE!T6*9125)NTAPDG*IRR 
GO  TO  7500 

6500  WRITE  (T6*9155)  EVAL*MODE 
7500  CALL  UNLOAD  !ITEMP) 

RETURN 

8000  FORMAT (5110) 

8001  FORMAT (5I10/4I10*E20.0) 

8005  FORMAT  (7E10.0) 

8010  FORMAT  <I10*E10.0> 
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9005 

9010 

9015 

9055 


8015  FORMAT  <  I10/(7E10.0) > 

9000  FORMAT  ( 1H1 • 5X » 70HBELOW  IS  THE  COMPLETE  FLEXIBILITY  MATRIX  UNSCALE 
ID.  THE  SCALE  FACTOR  =  1PE16 . 6/1H0 ) 

9001  FORMAT ( 1H1 ) 

FORMAT  (1H0.I5»1P7E16.6/(E22.6.6E16.6) ) 

FORMAT  <  1H1.5X.28HBELOW  IS  THE  DYNAMIC  MATRIX. /1H0) 

FORMAT ( 1H1.5X.25HBEL0W  IS  THE  MASS  MATRIX. /1H0/I10X.I5.F20.7)  ) 

FORMAT  (  1H1 »5X» 5HM0DE  I5.9HHAD  ONLY  F7.2.53H  PERCENT  ACCURACY.  WHI 
1CH  IS  UNDER  THE  GIVEN  LIMIT  OF  F7 . 2 / 1H0 * 5X * 58HTHE  TWO  VECTORS  WHIC 
2H  SHOULD  BE  IDENTICAL  ARE  GIVEN  BELOW. / 1H0/ ( 20X . 1PE 16 . 7 . 3X *  I  5 . 2X . E 
316.7)  ) 

9060  FORMAT  ( 1H0 » 5X # 77HABOVE  IS  THE  MATRIX  V  TRANSPOSE  M  V  .WHERE  V 
IIS  THE  MATRIX  OF  MODE  SHAPES ./ 1H0 . 5X .44HTHE  MAXIMUM  AND  MINIMUM  DI 
2AG0NAL  VALUES  ARE  F15.3.5H  AND  F 15 . 3 / 1H0 * 5X. 37HTHE  MAXIMUM  OFF  DIA 
3G0NAL  MAGNITUDE  =  F15.8) 

9065  FORMAT (1H0.I5.3X.1P9E12.2/I9X.1P9E12.2)) 

9070  FORMAT  t 1H1 » 5X » 28HBEL0W  IS  THE  INERTIA  MATR I X . / 1H0/ ( 1  OX » I  5 » 3X . F20. 

9075  FORMAT  ( 1H1 . 5X » 31HBEL0W  ARE  THE  SHAPES  FOR  MODES  I5.8H  THROUGH  1 5/1 
1H0 ) 

9076  FORMAT  (6I3X.I3.F14. 7) ) 

9080  FORMAT  ( 1H1 » 50X » 22HTABLE  OF  FINAL  RESULTS 
1/1H0.74X.10HPERCENTAGE 

2/33X.4HMODE .6X.7HRADIANS.10X.9HFREQUENCY.6X.8HACCURACY  »7X .4HM0DE 
3/33X.6HNUMBER.4X.10HPER  SECOND . 7X . 6H I N  CPS.9X.12HOF  FREQUENCY. 3X 
4 . 6HNUM3E  R/ (1H0*32X.I3*5X.F14.7.4X»F14,7.4X»F8.3*4X.I3)) 

9100  F0RMAT(1H1.38HFLEXIBILITY  MATRIX  COULD  NOT  OE  FOUND.) 

9115  FORMAT  ( 1H1 , 65HSP AC  I NG  ERROR  OCCURED  WHILE  TRYING  TO  WRITE  BINARY 
1TAPE.  NFILE  =  I5.7HNMAT  =  15) 

9125  FORMAT  ( 1H0 * 22HCURRENT  TAPE  IN  USE  «  I5.14H  ERROR  CODE  »  15) 

9155  FORMAT ( 1H1 .14H  EIGENVALUE  ■  E13.6.11H  FOR  MODE  I3.71H  HAS  A  NEGAT 
1IVE  VALUE.  WHICH  DOES  NOT  DESCRIBE  A  PROPER  PHYSICAL  SYSTEM) 

WHILE  WRITING  DYNAMIC  MATRIX  ON  TAPE.) 

WHILE  READING 
WHILE  WRITING 
WHILE  READING 


9200 

9205 

9210 

9215 


FORMAT (1H0.43HERROR 
FORMAT (1H0.45HERR0R 
FORMAT ( 1H0  *  40HERROR 
FORMAT (1 HO . 42HERR0R 
END 


DYNAMIC  MATRIX  FROM  TAPE.) 
MASS  MATRIX  ON  TAPE.) 

MASS  MATRIX  FROM  TAPE.) 
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SUBROUTINE  VALVCT 


SIBFTC  WOVALV  DECK 

SUBROUTINE  VALVCT ( D *N*MODES* EVALS .VECTRS ) 

DIMENSION  CN< 100) »SN<100) (D (100*100 ) *IR ( 100) *0RDER( 100) • 

1  EVALSI 100) tVECTRSI 100*25) (X< 100) 

INTEGER  ORDER 
KR* 1 00 

SUBROUTINE  HESSEN  TRANSFORMS  THE  DYNAMIC  MATRIX  TO  UPPER  HESSENBERG 
SUBROUTINE  HESSEN  USES  TAPE  4 

CALL  HESSEN ( D*KR  »N (MODES *CN *SN (VECTRS * EVALS. JL  * IR  *ORDER»X) 

SUBROUTINE  QRITER  TRANSFORMS  THE  HESSENBERG  MATRIX  TO  TRIANGULAR* 

THE  EIGENVALUES  ARE  THE  DIAGONAL  ELEMENTS. 

SUBROUTINE  QRITER  USES  TAPE  2 

CALL  OR  I  TER ( D*KR*N* MODES *CN»SN * VECTRS *EVALS*JL* IR (ORDER *X) 

SUBROUTINE  SORTRT  ORDERS  THE  ROOTS  ACCORDING  TO  ABSOLUTE  VALUE.  LGST  FIRST 
CALL  SORTRT ( D * KR * L * N .MODES *CN *SN * VECTRS * E VALS *JL t I R (ORDER *X ) 

ITMO=»L-JL+l 

I F ( ITMO.LT.MODES)MODES«ITMO 

SUBROUTINE  VECTOR  COMPUTES  THE  VECTORS  FOR  THE  TRIANGULAR  MATRIX. 

CALL  VECTOR ( D*KR  *L*N (MODES *CN  *SN  »VECTRS *  EVALS » JL . I R (ORDER  *X ) 

SUBROUTINE  TRANS1  TRANSFORMS  THE  VECTORS  TO  CORRESPOND  TO  THE 
HESSENBERG  MATRIX. 

SUBROUTINE  TRANS1  USES  TAPE  2 

CALL  TRANS1 (D.KR *L *N. MODES *CN * SN .VECTRS * EVALS . JL. I R »X ) 

SUBROUTINE  TRANS2  TRANSFORMS  THE  VECTORS  TO  CORRESPOND  TO  THE 
ORIGINAL  MATRIX. 

SUBROUTINE  TRANS2  USES  TAPE  4 

CALL  TRANS2(D.KR  *L.N» MODES (CN.SN. VECTRS (EVALS. JL. I R.X) 

7500  RETURN 
END 
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SUBROUTINE  HESSEN 


S18FTC  WDHESS  DECK 

SUBROUTINE  HESSEN ( D»KR  » N . MODES *CN  *SN tVECTRS.EVALS.JL.I R* ORDER » 
DIMENSION  CNOCR >,SN!KR> *DUR#KR) *IR(KR) , ORDER  OCR)  , 

I  EVALS(KR) *VECTRS(KR*1) .X!KR) 

INTEGER  ORDER  »R  »R2  «R3 
C 

C  TRANSFORM  ORIGINAL  MATRIX  TO  UPPER  HESSENBERG  FORM. 

IH  =  4 

REWIND  IH 

N2  *N-2 

DO  100  R= 1 *N2 

R2=  R+l 

XR  =  0.0 

DO  50  I =R2  »N 

XR2  =  ABS ( D ( I • R ) ) 

IF(XR2.LE.XR)GO  TO  50 
XR  =  XR2 
K.  *  I 

50  CONTINUE 
I  R  ( R  )  -  0 

I  F ( XR . EO.O .0  ) GO  TO  100 
I F ( K  *  EQ»  R2 ) GO  TO  65 
I R ( R ) =K 
DO  55  J=R*N 
XR  =  D ( R2 • J ) 

D  (  S2  *  J  )  =  DU.J) 

55  D(K.J)  *  XR 
DO  60  I  *  1 #N 
XR  =  D( I *R2) 

D ( I »R2 )  -  D ( I *K  ) 

60  D (  I  •  .<  )  =XR 
65  R 3  =R  +  2 

DO  80  I =R3  *  N 

I  F  {  D  (  I  »R  )  .  EQ.O  .  0  )  GO  TO  80 
XR  =-D(I.R)/D(R2*R) 

DO  70  J=R2*N 

70  D(I.J)  *  D( I . J)«-XR*D!R2 *J) 

DO  75  J-1»N 

75  D ( J  » R2  >-D(J.R2  )-XR*D(J»I) 

D ( I » R )  =  -XR 
80  CONTINUE 
100  CONTINUE 

STORE  UPPER  HESSENBERG  MATRIX  ON  TAPE» 

USED  TO  TRANSFORM  VECTORS  TO  CORRESPOND  TO  ORIGINAL  MATRIX. 
WRITE! IH»((D< I#JJ iJ-l.I )»I«1,N) 

ENDFILE  IH 
REWIND  IH 
RETURN 
END 


u  u  wu 


SUBROUTINE  QR ITER 


SUBROUTINE  QRI TER ( D*KR  *N *  MOOES *CN  *SN  *VECTRS»  EVALS* JL » I R.ORDER.X ) 
DIMENSION  CN(KR) »SN<KR) »D(KR*ICR) »IR(KR) »ORDER(KR) • 

1  EVALS(KR) * VECTRSI KR» 1 ) *X(KR) 

INTEGER  ORDER 


TRANSFORM  UPPER  HESSENBERG  MATRIX  TO  TRIANGULAR  FORM, 
EIGENVALUES  WILL  BE  THE  DIAGONAL  ELEMENTS. 

TOL  *  l.E-14 
JSi  =  0 
JS2  =  0 
JCTR  =  0 
IQ  «=  2 
LIMIT  -  10 
REWIND  IQ 
IDUM  =  1 
I DUM2=  0 
N1«N-1 
Jl-1 

ITER  -  0 

40  ITER  *  ITER+1 

IF(  ABS ( D < I  +  l *  I ) ) »GT»  ABS ( D ( 1  +  1 » I  +  l ) )*TOL )GO  TO  55 
50  CONTINUE 


WRITE  ZEROS  ON  TAPE  TO  INDICATE  END  OF  DATA. 

52  WRITE l IQ) IDUM, IDUM, < IDUM2, 1*1 »4) 

REWIND  IQ 
GO  TO  7500 
55  11*1  . 

J1P=J1+1 

DO  60  I "J1P  *N1  „„  „  ,  . 

I f (  ABS(D( 1  +  1,1 ) ) • LE »  ABSID( I  +  ltl  +  l) )*TOL)  GO  TO  65 

60  CONTINUE 
J2  *  N 
GO  TO  70 
65  J2  =  I 
70  DO  75  I  *  1 *N 

IF(D(  I , I ) . NE.O .0  ) GO  TO  80 
WRITE ( 6 , 1100 ) I 
75  CONTINUE 
PRINT  1 
WRITE ( 6 , 1 ) 

CALL  EXIT 


80  JL-I 
85  M  ■>  J2-1 

B  =  -D!M»M)-D( J2»J2) 

C  =  D(M»M)*D(J2*J2)-D< J2,M)*D(M*J2) 
RAD  *  B**2-4.0  *C 
IF (RAD.LT .0.0  ) GO  TO  90 
RAD  =  SORT ( RAD ) 

SHIFT  -  .50  * ( -B+RAD ) 


T  *  .50  M-B-RAD) 

I F (  ABS(SHIFT-D(J2*J2)).GT. 

GO  TO  95 

90  SHIFT  ■-.50  *B 


ABS!T-D( J2,J2) ) (SHIFT  - 


95  DO  100  I *J1 * J2 


T 
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100  Dlhll  =  D  (  I  » I  ) “SHI  FT 


115 

120 

135 

140 

150 


200 


250 

7500 

1 

1100 

1150 

1200 

1300 

1400 


DO  QR  PRE-MULT. 

DO  120  J  =  Jl.M 

RAD  -  SQRT<D< J+l . J ) **2+D ! J • J 
CN( J )  ■  D( J  * J ) /RAD 
SN(J)  *  D( J+l » J ) /RAD 
DO  120  I=J»N 

B  =  CN!J)*D< J.I )+SNt J)*D!J+1. 
D ( J+l  »  I )  «  -SN<  J)*D(  J.  ll+CN  (  J 
D(J. I)  =  B 


)##2> 


I  > 

)*D< J+l  .1  ) 


DO  QR  POST-MULT. 

DO  140  J“J1 *M 
JP  =  J+l 
DO  140  1=1. JP 

B  »  CN ( J ) *D ! I.J)+SN<J)*D( I • J+l ) 

D ( I » J+l )  =  “SN ( J ) *D( I .J) +CN ( J ) *D ( I »  J+l ) 
DdtJI  =  B 
DO  150  1=  J1.J2 
0(1*1)  =  DU. I  l+SHIFT 


STORE  ELEMENTS  USED  TO  TRANSFORM  VECTORS  TO  CORRESPOND  TO  HESSENBERG  MTX. 
WRITE < IQ) Jl.M. <SN<  I ) »CN( I > . I -Jl.M) 

I F (  JS1  »EQ.  Jl.AND.  JS2  .EQ.  J2  )  GO  TO  200 
JCTR  =  1 
JS1  =  J1 
JS2  =  J2 

I F  t  ITER  .LT.  500  )  GO  TO  40 
WRITEI6.1150) 

GO  TO  52 
JCTR  =  JCTR  +  1 

I F (  JCTR  .GE.  LIMIT  )  GO  TO  250 

GO  TO  40 

D(J2*J2-1)«0. 

GO  TO  40 
RETURN 

FORMAT! 1H0.39HDI AGONAL  OF  TRANSFORMED  MATRIX  IS  ZERO.) 

FORMAT (1H0.16HDI AGONAL  ELEMENT.  15.  9H  IS  ZERO.) 

FORMAT! 1H0.32HITERATI0N  LIMIT  OF  500  EXCEEDED.) 

FORMATUHO.IOIIO) 

FORMAT (1H0.8E16.8) 

FORMAT (lHO.I5t(7E16.8)) 

END 


38G 


no  n  n  no 


SUBROUTINE  SORTRT 


SIBFTC  WDSORT  DECK 

SUBROUTINE  SORTRT !D*KR*L»N.MODES*CN.SN»VECTRS»EVALS,JL.IR .ORDER .X) 
DIMENSION  CN(KR) .SN(KR) »D(KR*KR) *IR!KR) ♦ORDER(KR) « 

1  EVAL5  <  KR ) * VECTRSI KR  » 1 ) *X( KR ) 

INTEGER  ORDER 
C 

DO  20  1=  1 # N 
20  Xt I )  =  D ( I  *  I  I 

ORDER  THE  ROOTS  ACCORDING  TO  ABS. VALUE. 

DO  80  1=  JL.N 
A  =  0  •  0 
DO  60  J  =  JL  * N 

I  F (  ABStX(J) )  «  L  E  «  A  ) GO  TO  60 
A  *  ABS I X ( J ) ! 

ORDER (I)  «  J 
60  CONTINUE 

IFIA.EQ.0.0  )G0  TO  85 
J  =  ORDER! I ) 

80  X ( J )  =  0.0 
L  «  N 
GO  TO  86 

85  L  «  1-1 

MOVE  THE  ROOTS  BACK  INTO  ARRAY  X  IN  CORRECT  ORDER. 

86  DO  90  I  =  JL.L 
M  =  ORDER! I) 

90  X ( I )  =  D(M.M) 

M  *  JL+MODES-1 
I F ( M. GT  »  L ) M  =  L 

CHECK  FOR  NEGATIVE  ROOTS  AMONG  THE  FREQUENCIES. 

DO  100  I  * JL  »M 
I F ( X ! I ) . GE . 0 .0 ) GO  TO  100 
WR I TE ( 6  » 1300 ) I »X (  I ) 

100  CONTINUE 
M2-0 

DO  130  I = JL  i  L 
M2-M2+1 
130  EVALS(M2)  •  X! I > 

7500  RETURN 

1300  FORMAT ( 1H0* I 5#21H  NEGATIVE  EIGENVALUE-  .E16.8I 
END 
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SUBROUTINE  VECTOR 


SlBFTC  WDVECT  DECK 

SUBROUTINE  VEC TOR ( D» KR *L *N » MODES. CN *SN.V EC TRS.EVALS.JL.  I R, ORDER »X) 
DIMENSION  CN(KR) »SN ( KR  ) *D  <  KR  *KR ) *  I R ( KR ) .ORDER ( KR )  , 

1  EVALS(KR) *VECTRSIKR»1 ) *X(KR) 

INTEGER  ORDER 

COMPUTE  VECTORS  CORRESPONDING  TO  THE  TRIANGULAR  MATRIX. 

M  =  JL+MODES-1 
IF(M.GT.L)M=L 
DO  120  L5  =  JL . M 
K  =  ORDER  t  L5 )  - 
DO  50  I  3 JL  *  N 
50  XII)  =  0.0 

CURRT  ■  D(K.K) 

DO  60  I  =  JL  .K 
60  D ( I » I )  =  D ( I » I ) -CURRT 
X  <  K )  =  1.0 
J  =  K 

65  IF(J.EQ.JL)  GO  TO  80 

IF(D< J-l  ,J-1 ) .EQ.0.0  )  GO  TO  130 
SUM  =  0.0 
DO  70  I  =  J,K 

70  SUM  =  SUM+D ( J-l • I )*X< I) 

X(J-l)  =  -SUM/ D ( J— 1 »  J-l  ) 

J  *  J-l 
GO  TO  65 

80  DO  90  I  =  JL t K 
90  D(I. I)  =  D  (  I  .  I  )  +CURRT 
SUM  =  0.0 
DO  100  I  »  JL  t  K 
CURRT  =  ABSIX(D) 

IF(CURRT.GT.SUM) SUM  -  CURRT 
100  CONTINUE 

DO  110  I  =  JL  t  K 
110  VECTRS < I ,L5 ) «X ( I ) /SUM 
K1=K+1 

DO  115  I=K1.N 
115  VECTRSI I .L5)»X( I ) 

120  CONTINUE 

GO  TO  7500 
130  PRINT  1 

MODES-L5-1 
7500  RETURN 

1  FORMAT (38HOVECTOR  SOL.  FAILS  DUE  TO  ZERO  ON  DIAG) 

END 
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SUBROUTINE  TRANS1 


SIBFTC  WDTRN1  DECK 

SUBROUTINE  TRANS  1 ( D . KR • L *N * MODES »CN • SN • VECTRS »E VALS . JL *  JR  »X  » 
DIMENSION  CN(KR) *SN ( KR ) *D ( KR #KR ) * IR I KR) • 

1  EVALS(KR) .VECTRSIKR.l ) .X<KR) 

TRANSFORM  VECTORS  TO  CORRESPOND  TO  THE  HESSENBERG  MATRIX. 

IQ  -  2 

DO  50  I  =  1 • N 
DO  50  J  =  1  * N 
50  D< I.J)  =  0.0 
DO  60  I  »  1 i N 
60  D ( I • I )  =  1.00 

70  READ! IQ) Jl.M. (SN(I) »CN( I ) *1  ■  J1*M) 

IFISNIJ1 ) .EQ.0.0  .AND.CNIJ1 ) .EQ.0.0  )  GO  TO  150 
DO  140  J  *  Jl.M 
DO  140  I  =  l.N 

SUM  =  CN ( J I *D ( I  * J )+SN ( J ) *Dt I •  J+l ) 

D (  I » J+l )  *  -SN( J)*D( I .J )+CN ( J)*D( I . J+l ) 

140  D ( I . J )  =  SUM 
GO  TO  70 
150  REWIND  IQ 

DO  170  I  -  l.N 
170  X(I)  =  0.0 

M  *  JL+MODES-1 
I F (M.GT.L )  M  =  L 
DO  250  K  ■  JL.M 
DO  200  I-JL.N 
200  X ( I ) =VECTRS( 1 »K ) 

DO  240  I  ■  l.N 
VECTRSI I .KJ-0.0 

240  CALL  INRPRD(D(  I.l).KR.X.l.VECTRS(I.M.N) 

250  CONTINUE 
RETURN 
END 
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SUBROUTINE  TRANS2 


$  I BFTC  WDTRN2  DECK 

SUBROUTINE  TRANS2 ( D * KR »L I N »N .MODES# CN *SN * VECTRS »E VALS » JL » I R »X ) 
DIMENSION  CNIKR ) .SN(KR) *D(KR*KR) • I R ( KR) • 

1  EVALS(KR) .VECTRSIKR.l ) #X(KR) 

INTEGER  R*R2 

TRANSFORM  VECTORS  TO  CORRESPOND  TO  THE  ORIGINAL  MATRIX. 

I H  *  4 

READ (  I  H  )  (  (  D  (  I  #  J  )  » J  »  1 »  I  )  •  I  ■  1 »N ) 

N2  =  N-2 

DO  300  K  =  1 .MODES 
JLK=JL+K-1 

I F ( JLK.GT.L1NIG0  TO  500 
DO  100  I  =  1  »N 
100  X(  I)=VECTRSf I*JLK) 

R  =N2 

DO  175  I1*JL.N2 
160  R2  =  R+2 
J=N 

DO  170  I2-R2.N 
X(J)=X( JI+DI J»R)*X(R+1 J 
170  J=J-1 

L  =  I R  <  R  ) 

I F ( L  *  EQ  #  0 ) GO  TO  175 
SUM  =  X ( L ) 

X(D  =  X  (  R+l  I 
XIR+l)  *  SUM 
175  R«R-1 

SUM  *  0.0 
DO  180  I  ■  1 *N 

I  F  t  ABStxmi.GT.  ABS  ( SUM  )  )  SUM-X(I) 

180  CONTINUE 

DO  190  I  -  1 »N 
190  X<I)  =  XII)/ SUM 
200  DO  250  I  “1  #N 
250  VECTRSI I #K)*X( I J 
300  CONTINUE 
500  RETURN 
END 


r>  nnrmnfinnnnonnnnnnnnnnnnnnnAnn 


SUBROUTINE  AMERGE 


SIBFTC  AMERG«  DECK 

SUBROUTINE  AMERGE(  ITAPE*  NTAPE*  NF1  ) 

•  ♦♦♦  SUBROUTINE  TO  FORM  FULL  ST  I FFNESS. AND  FLEXIBILITY  MATRIX  FROM 
SUB-MATRICES 

*  * 

♦SUBROUTINE  MERGE  * 

*  * 

♦  MERGES  THE  STIFFNESS/FLEXIBILITY  MATRIX  * 

*»  * 

♦ 


NT 

NROW 

NCOL 


FINAL  STIFFNESS/FLEXIBILITY  MATRIX  SIZE 

no  of  row  partitions  to  merge 

NO  OF  COL  PARTITIONS  TO  MERGE 


SMAT ( I *J) 


FINAL  MERGED  NT  X  NT  MATRIX 


NPRNTK  =  0  NO  PRINTOUT  OF  STIFFNESS  MATRIX 

-  NOT  0  PRINTOUT  THE  STIFFNESS  MATRIX 

ITAPE  -  A  PARAMETR  MATRIX*  STIFFNESS  MATRIX  AND  THE  FLEXIBILITY 
MATRIX  IS  STORED  ON  THIS  TAPE. 

NTAPE  -  THE  MERGED  MATRIX  IS  STORED  ON  THIS  TAPE 
NF1 ■ 1  IF  THE  STIFFNESS  MATRIX  IS  DESIRED 

nfi=2  if  the  flexibility  matrix  is  desired 

THE  FLEX  MATRIX  IS  USED  AS  INPUT  TO  EIGENVALUE-EIGENVECTOR  ROUTINE  TV-105W 
THE  MAX  SIZE  OF  THE  STIFFNESS  AND  FLEX  MATRIX  IS  (100X100) 


COMMON  /PRNT /  NPRNTK 

DIMENSION  SMAT (100*100) *  SCRAT ( 60 ♦ 60 ) * B ( 16 ) *  PARAM150)*  IPARAM(50) 
EQUIVALENCE  ( P AR AM* I PARAM ) 

REWIND  ITAPE 
I  SUM a 0 
JK  =  0 
I  J  =  0 
NT-0 

NST  =  NF1 
NAME=0 
NFILE  *  0 
NMAT  =  0 

CALL  READTP ( PAR AM  *  1 *NAME*M*N*B, NFILE *NMAT  *  I T  APE  *  I RR  ) 

IF( IRR  .NE.  0)  GO  TO  1010 
NR0W=IPARAM(5) 

NCOL= I P ARAM ( 3 ) 

NMAT  *  0 
NFILE  -  0 
M*0 


DO  500  I  1*1 *NROW 
JSUM*0 
I SUM= I SUM+M 
N*0 

NT-NT+M 
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n  n 


00  500  1=1* NCOL 
JSUM* JSUM+N 
NAME=0 

CALL  READTP ( SCRAT *60* NAME *M*N*B*NF1* NMAT. I  TAPE. IRR) 

I F ( I RR  .NE.  0 ) GO  TO  1010 

NF1  =  0 

DO  200  J»1*M 

I  J= I SUM+J 

DO  100  K.=  1  *N 

JK« JSUM+K 

100  SMATI I J.JK)»SCRAT( J.K) 

200  CONTINUE 
500  CONTINUE 


C 


9800 

C 


1010 

1020 

6001 

6002 

9600 

9720 

7500 


NT  =  NT +M 
NAME  -  0 
NFILE  *  0 
NMAT  =  0 

CALL  WRTETPISMAT ,100 • NAME *NT »NT * B .NF I LE * NMAT .NTAPE . I RR ) 

I F ( I RR  .NE.  0 ) GO  TO  1020 
I F (  NST  .NE.  1  )  GO  TO  7500 
I F (  NPRNTK  .EQ.  0  )  RETURN 
WR  I  TE ( 6  »  9600 )  NT .NT 

DO  9800  I  -  1 *NT 

WRITE (6*9720) I ♦ (SMATI I • J ) * J«1 »NT  ) 

CONTINUE 

GO  TO  7500 

WRITE  (6*6001)  IRR 

GO  TO  7500 

WRITE  (6*6002)  IRR 

FORMAT (22H1ERROR  CODE  IN  READTP«*I3) 

FORMAT ( 22H1ERR0R  CODE  IN  WRTETP*  » I  3  > 

FORMAT (1H1*40X*17H  STIFFNESS  MATRIX  .8X.I3.4H  BY  I3/1H0  ) 
FORMAT (1H0*I5*1P7E16*6/(E22*6*6E16.6)  ) 

RETURN 

END 
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nr>  non  nrtfionnnnnnncnnfinnnfinnnnnnnnn 


SUBROUTINE  SMERGE 


SlBFTC  SMERG*  DECK 

SUBROUTINE  SMERGE  (  I  TAPE *NT APE » I  TEST  ) 

»«»  SUBROUTINE  TO  MERGE  AND  REPARTITION  THE  STRESS  MATRIX 


♦  MERGE 
AND 

♦  FOR 

♦ 


♦ 

♦ 

♦ 


ROUTINE  TO 
REPARTITION 
PLATES  AND  BEAMS 


MERGE 
STRESSES 


♦ 

♦ 

♦ 


ITEST  «  8 

■  6 


PLATES 

BEAMS 


NSTRSP  «  0 

NOT  0 


DONT  MERGE  THE  STRESS  FOR  PLATES 
MERGE  THE  STRESS  FOR  PLATES 


NSTRSB  *  0 

NOT  0 


DONT  MERGE  THE  STRESS  FOR  BEAMS 
MERGE  THE  STRESS  FOR  BEAMS 


ITAPE  ~  THE  PARAMETER  AND  STRESS  MATRIX  IS  STORED  ON  THIS  TAPE 
NTAPE  -  THE  MERGED  MATRIX  IS  STORED  ON  THIS  TAPE 


♦** I CNT 1 
♦♦♦ICNT2 


COUNT  OF  END  I  OR  END  2 

COUNT  OF  NUMBER  OF  BEAM  ELEMENTS 


♦  ♦♦ 


COMMON /PRNT/NPRNTK* NSTRSP • NSTRSB 

DIMENSION  SMAT (96*100) *  SCR AT (96*60) »Bt 16 ) *IPARAM(50) » PAR AMI  501* 
1  DMAT ( 8  * 100 ) 

EQUIVALENCE  I  P ARAM * I PARAM  ) 

REWIND  ITAPE 


JK  a  0 
NT  “  0 
NAME  “  0 
NFILE  *  0 
NM AT  *  0 

CALL  READTPI  PARAM* 1 »NAME  #M  *N  *  B*NF I LE  *NMAT ♦ ITAPE  *  I RR  ) 

IF(  IRR  #NE»  0  )  GO  TO  1010 

THE  NO*  OF  COL.  PARTITIONS  IS  NCOL  AND  ROW  PARTITIONS  IS  NROW 


NROW  =  I PARAM ( 5 ) 
NCOL  «  IPARAMI 2 ) 
NMAT  «  0 
NFILE  -  0 
M  ■  0 


NF1  =  1 

I F (  ITEST  *EQ.  8  )  GO  TO  50 
IF  (  NSTRSB  *EQ.  0  I  GO  TO  60 
WRITE(6*9000) 

GO  TO  60 


^  ^  ^  u  u  u  u  u  vi  u 


50  I F (  NSTRSP  .EQ.  0  ) 
WRITE16.9001) 

60  CONTINUE 
C***  INITIALIZE 

ICNT1  «  X 
ICNT2  ■  0 

00  600  I  I  ■  l.NROW 


JSUM  *  0 
N  *  0 
NC«  0 

DO  500  I  =  1»NC0L 
JSUM  =  JSUM  +  N 
NAME  =  0 

CALL  READTP (SC RAT  .96.NAME.M.N.B.NF1 *NMAT  *ITAPE»IRR  ) 

I F (  IRR  *NE*  0  )  GO  TO  1010 
NF1  =  0 

DO  200  J  *  1 »M 
DO  100  K  *  1*N 
JK  *  JSUM  ♦  K 
NK  ■  J< 

100  SMAT ( J  *  JK )  «  SCRAT(J.K) 

200  CONTINUE 

NC  =*  NC  +  N 

500  CONTINUE 

RE-PARTITION  FOR  EACH  ELEMENT  OF  BEAM  OR  PLATE 
JJ  «  0 

***  SET  ITEST  «  8  FOR  PLATES 
»**  SET  ITEST  ■  6  FOR  BEAMS 
NT  =  NT  +  M 

IJ  =  0 

DO  550  I  ■  1  #M 
JJ  =  JJ  +  1 
IJ  =  IJ  +  1 
DO  505  J  -  1»NC 
DMATIJJtJ)  -  SMAT ( I J • J ) 

505  CONTINUE 
NMAT  =  0 
NAME  =  0 

I F (  JJ  .LT.  ITEST  )  GO  TO  550 
JJ  «  0 

CALL  WRTETP (  DMAT , 8 . NAME f I  TEST .NC #B . NFI LE .NMAT ,NTAPE . I RR  ) 
IF!  IRR  .NE.  0  )  GO  TO  1020 


I F (  ITEST  *EQ.  8  I  GO  TO  510 
I F (  NSTRSB  .EQ.  0  )  GO  TO  550 
C***  PRINT  OUT  BEAM  STRESSESI6XN) 
IF!  ICNT2  .NE.  0  )  GO  TO  506 
ICNT2  «  ICNT2  ♦  1 
WR I TE ( 6  # 9002 )  ICNT2 
GO  TO  508 

506  I F (  ICNT1  .EQ.  2  )  GO  TO  508 
ICNTl  »  1 
ICNT2  -  ICNT2  f  1 
WRITE! 6.9002 )  ICNT2 


GO  TO  60 

ICNTl  AND  ICNT2 
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non  on 


508 


509 


510 

C*** 


520 

C 

C 

550 


WR ITE ( 6  *  9006 I  ICNT1 
DO  509  LL  ■  1 • I  TEST 


WR ITE ( 6  *  9003 )  LL*< 
CONTINUE 

ICNT1  -  ICNT1  1 
GO  TO  550 
I F (  NSTRSP  • EQ «  0) 
PRINT  OUT 
ICNT2  ■  ICNT2  +  1 
WR I T  E ( 6 ♦ 9004 )  ICNT2 
DO  520  LL  ■  1*1  TEST 
WR 1 TE ( 6  * 9005 )  LL*  ( 


DMAT(LL*MM) ,MM»1*NC 

GO  TO  550 

PLATE  ST 

DMAT ( LL  *MM ) *MM  -  1 


) 

RESSESI8X 

NC  ) 


N  ) 


CONTINUE 


600  CONTINUE 


1010 

1020 

6001 

6002 

9000 

9001 

9002 

9003 

9004 

9005 

9006 
7500 


GO  TO  7500 
WR I TE ( 6  *  6001 ) I RR 
GO  TO  7500 
WRITE(6*6002) IRR 
GO  TO  7500 

FORMAT ( 22H  ERROR  CODE  IN  READTP«  13  ) 

FORMAT ( 22H  ERROR  CODE  IN  WRTETP-  13  ) 

FORMAT < 1H1 *40X • 21H  BEAM  STRESS  MATRICES  /1H0  ) 
FORMAT ( 1H1 *40X*22H  PLATE  STRESS  MATRICES  /1H0  ) 
FORMAT <1H0*5H8EAM  13  ) 

FORMAT  1 1H0*13X* I3*1P7E16»6/(17X*7E16#6)  ) 

FORMAT (1H0*5HPLATEI 3) 

FORMAT (1H0*8X*I3*1P7E16«6/<12X,7E16»6)  ) 

FORMAT ( 1H0*8X*»HENDI 2 ) 

RETURN 

ENO 
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PHASE  I  TLOI  DATA  LISTING 


8000B 

8200B 

9000B 
- 4000000B 
- 8000000B 

200B 

- 1 1000000B 
- 1 2000000B 

400 000 OB 

8000B 

8003B 

4003000B 

8004B 

8005B 

1008B 

11000000B 

IB 

8003B 

IB 

IB 

400000  OB 

2B 

IB 

2B 

3B 

3B 

8000000B 

-3B 

8005B 

1079B 

11000000B 

IB 

999B 

IB 

8000000B 

— 2B 

400  000  OB 

IB 

8003B 

IB 

8000000B 

-2B 

8005B 

-6B 

-4000000  B 
-8000000B 

8003B 

- 1 1000000B 

8005B 

4B 

8003B 

8006B 

OB 

800  3  B 

-IB 

8004B 

8000000B 

IB 

-IB 

IB 

IB 

OB 

-1014B 

8000000B 

-IB 

2B 

IOOOB 

IB 

2  B 

3B 

OB 

-1014B 

3B 

IIOOOOOOB 

100B 

-4B 

1 1000000B 
- 1 1 OOOOOOB 

8004B 

8000000B 

IB 

1 10000  OOB 

2B 

IB 

2B 

3B 

22B 

3B 

2B 

23B 

800000  OB 

3B 

3B 

2B 

3B 

OB 

-1014B 

3B 

12000000B 

10B 

-7B 

8004B 

-10B 

—  8000000B 
-IIOOOOOOB 

8003B 

110000008 

IB 

IB 

12000000B 

-2B 

1 2000000B 
- 12000000B 
-IIOOOOOOB 

8004B 

29B  CLEAR 

OB  LOAD  AND  EXEC. 

OB 

OB 

OB 

OB 

OB 

OB 

2  7B 

OB 

OB  IS  K22  UNPARTITIONED 

08 
I8B 
OB 
68 
OB 
OB 
OB 
OB 
OB 
OB 
OB 
OB 
OB 
OB 
OB 
OB 
OB 
29B 


2  7B 

SAVE  N  FOR  LOOPING 

27B 

DECREMENT  n 

27B 

DECREMENT  K 

OB 

PIVOT  PARTITION 

VT1 

18B 

INVERT 

27B 

OB 

REST  OF  PIVOT  ROW 

VT2 

6B 

NEW  PIVOT  ROW 

27B 

CHANGE  NAME 

OB 

ON  TAPE  2 

OB 

ALL  OF  PIVOT  ROW 

OB 

OB 

OB 

PART.  TO  BE  ZEROED 

VT  3 

OB 

PI VOT  ROW 

6B 

MULTIPLY 

OB 

COPY 

06 

ROW  OF  ZERO 

VT4 

28 

NEW  TERM  OF  ROW 

27B 

CHANGE  NAME 

OB 

TO  TAPE  1  OR  3 

VT5 

OB 

ALL  TERMS  OF  ROW 

OB 

FOR  N-l  ROWS 

OB 

VT6 

OB 

OB 

PIVOT  ROW 

08 

TO  TAPE  3  OR  1 

VT7 

OB 

ALL  OF  THE  ROW 

OB 

VT8 

OB 

VT9 

OB 
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101  38 

8005B 

OB 

EVERY  OTHER  TIME 

-1291B 

-IB 

400000  OB 

27B 

CHANGE  VT1  TO  3 

-12719 

-IB 

40000008 

27B 

CHANGE  VT 2  TO  3 

-12118 

-18 

4000000B 

278 

CHANGE  VT3  TO  3 

-11819 

-18 

40000008 

278 

CHANGE  VT 4  TO  3 

-11638 

-IB 

-4000000B 

27B 

CHANGE  VT 5  TO  1 

-11428 

-18 

-40000008 

2  78 

CHANGE  VT 6  TO  3 

-11238 

-IB 

-40000008 

278 

CHANGE  VT 7  TO  1 

-11128 

-18 

-4000000B 

2  78 

CHANGE  VT  8  TO  1 

-11128 

-IB 

4000000B 

278 

CHANGE  VT 9  TO  1 

8005B 

18 

29B 

CLEAR 

800  5  9 

28 

2  7B 

SET  UP  FOR  NEXT 

101  18 

2558 

OB 

TO  END  POINT 

-14118 

-  IB 

-40000008 

278 

CHANGE  VT 1  TO  1 

-13919 

-18 

-4000000B 

27B 

CHANGE  VT 2  TO  1 

-13318 

-19 

-4000000B 

278 

CHANGE  VT 3  TO  1 

-13016 

-18 

-4000000B 

2  78 

CHANGE  VT 4  TO  1 

-12839 

-18 

40000008 

27B 

CHANGE  VT 5  TO  3 

-1262B 

-18 

4000000B 

27B 

CHANGE  VT 6  TO  1 

-1243B 

-IB 

40000008 

27B 

CHANGE  VT  7  TO  3 

-12328 

-IB 

40000008 

27B 

CHANGE  VT 8  TO  3 

-1232B 

-18 

-40000008 

278 

CHANGE  VT9  TO  3 

800  5  8 

IB 

29B 

CLEAR 

-528 

8006B 

OB 

1007B 

80048 

OB 

100  2  B 

8005B 

09 

IF  8005=0  SOLUTIO 

1004  B 

9998 

08 

LEAVE  ON  TP  8 

12000000B 

IB 

08 

IB 

80000008 

08 

COPY  ONTO  TP  8 

-28 

80068 

08 

10068 

9998 

09 

100  5  B 

8005B 

OB 

IF  8005=0  SOLUTIO 

8000000B 

18 

OB 

IB 

1 2  00 000 OB 

COPY  ONTO  12 

— 2B 

80048 

08 

-38 

8006B 

OB 

- 4000000B 

08 

- 8000000B 

08 

-  1 1 OOOOOOB 

OB 

-120000008 

OB 

8175B 

1  B 

98 

20B 

PHASE  1.1  IS  COMPLETE 

8000  B 

2008 

298 

CLEAR  200  CELLS 

8200B 

08 

LO AD+EXECUTE 

-4000000B 

OB 

REW  4 

-2000000B 

09 

-80000008 

09 

REW  8 

-  1 1000000B 

08 

REW  11 

- 1 2000000B 

08 

-  16000000R 

08 

9000B 

08 

PARTITION 

4000000B 

8  0  0  0  B 

OB 

READ  PARAMETERS 

8000B 

20000008 

08 

COPY  PARAMETERS 

20000008 

08 

EOF  T2 

108  2  B 

8005B 

278 

100  2  B 

80038 

OB 

GNE  ROW  PARTITION 

10 1  3  B 

9998 

08 

1004B 

8005B 

08 

ONE  COL  PARTITION 

101  IB 

999B 

08 
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8 


ON  8 


L012B 

IB 

2  76 

1 2000000B 

OB 

FS  T12/F0 /M(  I  ) 

100  2  B 

999B 

OB 

1  1999999B 

OB 

12000000B 

IB 

OB 

IB 

8000000B 

OB 

X= ( K22) I NV*K21 

-3B 

8003B 

OB 

FORM  A  COLUMN 

- 1 2000000B 

OB 

-88 

8005B 

OB 

8000000B 

OB 

EOF 

- 8000000B 

INITIAL  REWINDS 

4002000B 

OB 

4000000B 

IB 

OB 

READ  K 1 2 

IB 

11000000B 

OB 

STORE  K12 

-2B 

8003B 

OB 

CYCLE  N  TIMES 

1 1000000B 

OB 

EOF 

-4B 

8005B 

OB 

CYCLE  M  TIMES 

-  1 10000008 

OB 

REW  11 

- 4000000B 

OB 

1 1000000B 

IB 

OB 

READ  K 12 

800000  0  B 

2  B 

OB 

READ  K22- 1 *K2 1 

IB 

2B  3B 

6B 

MULTIPLY 

3B 

IB 

OB 

COPY 

10048 

999P 

OB 

1 10000  OOB 

2B 

OB 

READ  K 1 2 

8000000B 

3B 

OR 

K22-1  *  K21 

2B 

3  B  IB 

30B 

MULTIPLY 

— 3B 

8003B 

OB 

CYCLE  N-l 

100  1  B 

999B 

OB 

4001000B 

OB 

-10218 

2B 

2  7B 

400 000 OB 

2B 

OB 

READ  K 1 1 

2B 

IB  2  B 

28 

SUBTRACT 

2B 

2000000B 

OB 

-  11001000B 

OB 

BS  Tll/Fl/MO 

-16  B 

8005B 

OB 

- 8  OOOOOOB 

OB 

REW  8 

l 1001000B 

OB 

FS  Tll/Fl/MO 

—  19B 

8005B 

OB 

2  OOOOOOB 

OB 

- 11000000B 

OB 

REW  11 

- 2000000B 

OB 

800000  OB 

IB 

OB 

IB 

16000000B 

OB 

—  2B 

8003B 

OB 

—  3B 

80058 

OB 

1 60000008 

OB 

-  16000000B 

OB 

- 8000000B 

OB 

REW  8 

-4000000B 

OB 

REW  4 

8160B 

IB 

9B 

2  OB 

PRINT  COMMENT 

EX  IT 

PHASE  1.2  IS  COMPLETE 

8000B 

100B  29B 

8 10  0  B 

OB 

LOAD 

-4000000R 

OB 

- 2000000B 

OB 

9000B 

OB 

PART 
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4000000B 

8000B 

OB 

READ  PARAMETERS 

-4000000B 

OB 

REW  4 

2001000B 

OB 

8075B 

9B 

I9B 

PRINT  TITLE 

2000000B 

IB 

08 

READ  K  INV 

1014B 

IB 

27B 

PREPARE  NAME 

IB 

IB  1000B 

OB 

IB 

8075B 

20B 

PRINT  K  INV 

-4B 

80053 

OB 

CYCLE  M 

— 1034B 

-IB 

27B 

DECREMENT  NAME 

-IB 

8005B 

08 

-1054B 

-IB 

IOOOB 

2  7B 

INCREMENT  NAME 

—  8B 

8005B 

OB 

CYCLE  M 

-2000000B 

OB 

REW  7-81 

8055B 

IB 

9B 

20B 

COMMENT 

EXIT 

K  RED  — 

MATRIX  NUMBER  =  1*1000  +  J 

PRINTING 

OF  K  RED  IS  COMPLETE 

8000B 

2003 

29B 

CLEAR 

8200B 

OB 

LO  AD+EXEC  UTE 

-4000000B 

08 

REW  4 

-80000008 

OB 

REW  8 

-11000000B 

OB 

REW  11 

- 2000000B 

08 

REW  2 

90003 

OB 

PARTITION 

4000000B 

8300B 

OB 

READ  PARAMETERS 

— 4000000B 

08 

20010003 

OB 

FS  T2/F1/M0 

1009B 

999B 

OB 

2000000B 

IB 

08 

READ  K 

18 

IB 

2B 

23 

SUBTRACT 

28 

8006B 

23 

17B 

ADD  1.0  TO  DIAOGNAL 

2B 

1 1  OOOOOOB 

OB 

STORE  IDENTITY  MAT 

2000000B 

18 

OB 

READ  K 

IB 

IB 

2B 

28 

SUBTRACT 

2B 

110000008 

OB 

-3B 

8005B 

08 

CYCLE  M 

-8B 

80053 

OB 

2000000  B 

IB 

OB 

READ  K 

IB 

IB 

28 

28 

NULL  MATRIX 

2B 

8006B 

2B 

17B 

AOD  1.0  TO  DIA 

2B 

1 1000000B 

08 

1 10000008 

OB 

-110000003 

OB 

REW  11 

-20010003 

08 

BS  T2/F1/M0 

2000000B 

13 

OB 

READ  K  L.HS 

IB 

8000000B 

OB 

-2B 

80053 

OB 

1 1000000B 

IB 

OB 

READ  R.H.S 

IB 

8000000B 

OB 

-2B 

8005B 

OB 

CYCLE  M 

— 6B 

8005B 

OB 

CYCLE  M 

8  OOOOOOB 

08 

EOF 

1 1000000B 

OB 

REW  11 

- 8000000B 

OB 

REW  8 

2  001000B 

08 

FS  T2/F1/M0 

800  3  B 

2B 

29B 

8003B 

8005B 

27B 

8003=M 

399 

800  3  B 

8004B 

8005B 

27B 

80  04=  2M 

81608 

IB 

9B 

208 

PR  I  NT 

EX  I  T 

+ 

PHASE  3  —  PART  1  IS  COMPLETE 

8200B 

OB 

LOAO+EXECUTE 

10148 

80038 

SKIP  IF  N  NOT  1 

9000B 

08 

PARTITION 

800000  0  B 

18 

OB 

Dl  1 

IB 

18 

1  8B 

INVERT 

10048 

9998 

800000  0  B 

28 

OB 

DIO 

IB 

2  B  38 

6R 

MULTIPLY 

38 

20000008 

OB 

COPY  K  INV 

-3B 

80048 

20000008 

OB 

END  OF  FILE 

-8000000B 

OB 

-20000008 

08 

REW  2 

1073B 

999P 

08 

82008 

58 

20B 

9000B 

08 

PAPTI TTON 

- 8000000B 

INITIAL  REWINDS 

-  11000000B 

OB 

-  120000008 

OB 

-  1 10000008 

-  120000008 

800  58 

4B 

29B 

8003B 

8006B 

OB 

278 

SAVE  N  FOR  LOOPING 

800  3  8 

-18 

278 

CECPEMFNT  N 

8004B 

-IB 

278 

DECREMENT  K 

8000000B 

IB 

OB 

PIVOT  PARTITION 

V  T  1 

IB 

LB 

18B 

INVERT 

-10148 

-IB 

1000B 

278 

8000000B 

28 

OB 

REST  OF  PIVOT  ROW 

VT  2 

IB 

2  8  3B 

OB 

68 

NEW  PIVOT  ROW 

-1014B 

100B 

27B 

CHANGE  NAME 

3B 

1 1000000B 

OB 

ON  TAPE  11 

-4B 

8004B 

08 

ALL  OF  PIVOT  ROW 

1 10000008 

OB 

- 11000000B 

08 

80000008 

18 

OB 

PART.  TO  BE  ZEROED 

VT  3 

1 10000  008 

28 

08 

PIVOT  ROW 

LB 

2  R  3R 

22  B 

68 

MULTIPLY 

3B 

28 

23B 

08 

COPY 

8000000B 

3B 

08 

ROW  OF  ZERO 

VT4 

3B 

2  B  38 

OB 

28 

NFW  TERM  OF  ROW 

-10 14B 

10B 

27B 

CHANGE  NAME 

3B 

12000000B 

OR 

TO  TAPE  1  OR  3 

VT5 

-7B 

8004B 

08 

ALL  TERMS  OF  POW 

-10B 

R0038 

08 

FOR  N-l  ROWS 

-80000008 

08 

VT  6 

-110000008 

08 

11000000B 

IB 

OB 

PIVOT  ROW 

IB 

1  20000  OOB 

08 

TO  TAPE  3  OR  1 

VT  7 

-2B 

80048 

08 

120000008 

OR 

VT  8 

-  120000008 

08 

VT  9 

-  1 1000000B 

08 

101  3B 

80058 

OB 

EVERY  OTHER  TIME 

-1291B 

-IB 

4000000B 

27B 

CHANGE  V T 1  TO  3 

-127  IB 

-IB 

40000008 

27B 

CHANGE  VT  2  TO  3 

400 

-121  IB 

-1R 

40000008 

27R 

CHANGE 

VT  3 

TO 

3 

—11818 

-IB 

40000003 

27B 

CHANGE 

VT  4 

TO 

3 

—11638 

-IB 

-40000008 

2  7B 

CHANGE 

VT  5 

TO 

1 

-11428 

-18 

-4000000B 

27B 

CHANGE 

VT  6 

TO 

3 

-11238 

-  IB 

-40000008 

2  78 

CHANGE 

VT  7 

TO 

1 

-11128 

-18 

-40000  OOB 

27B 

CHANGE 

VT  8 

TO 

1 

-11128 

-  IB 

40000008 

278 

CHANGE 

VT9 

TO 

1 

8005B 

18 

29B 

CLEAR 

800  5  B 

28 

27B 

SET  UP 

FOR 

NEXT 

10118 

2558 

OB 

TO  END 

POINT 

-14113 

-18 

-40000008 

27B 

CHANGE 

VT  1 

TO 

1 

-13918 

-IB 

-40000  OOB 

27B 

CHANGE 

VT  2 

TO 

1 

-13313 

-IB 

-4000000B 

2  78 

CHANGE 

VT  3 

TO 

l 

-13018 

-IB 

-4000000B 

278 

CHANGE 

VT  4 

TO 

1 

-12833 

-  IB 

400000  OB 

27B 

CHANGE 

VT  5 

TO 

3 

-12623 

-IB 

40000008 

278 

CHANGF 

VT  6 

TO 

1 

-12433 

-13 

40000008 

27B 

CHANGE 

VT  7 

TO 

3 

-12328 

-IB 

400000  OB 

27B 

CHANGE 

VT  8 

TO 

3 

-12328 

-IB 

- 40000  OOR 

27B 

CHANGE 

VT  9 

TO 

3 

800  5  8 

IB 

29B 

CLEAR 

-52  B 

8006B 

OB 

1002B 

80058 

08 

IF  8005=0. 

OUT 

101  18 

-  IB 

-4000000B 

2  78 

120000003 

18 

OB 

READ 

IB 

20000008 

08 

-28 

80048 

OB 

NO  OF  l 

COL 

PARTS 

-3B 

80063 

OB 

NO  OF  I 

ROW 

PARTS 

20000008 

08 

END  OF 

FILE 

-20000008 

08 

REW  2 

-80000008 

03 

81608 

18 

98 

2  OB 

PRINT  COMMENT 

PHASE  3  IS  COMPLETE 

8000B 

100B 

29B 

81008 

OB 

LOAD 

-40000008 

08 

-20000008 

08 

90008 

08 

PARTITION 

40000008 

80008 

03 

READ  PARAMETERS 

-40000003 

08 

REW  4 

2  0020008 

08 

FS  T7/F2AM0 

807  5  B 

9B 

19B 

PRINT  TITLE 

2000000B 

18 

OR 

READ  K  INV 

10148 

IB 

27B 

PRFPARE  NAME 

IB 

IB 

1000R 

OB 

IB 

8075B 

20R 

PRINT  K  INV 

— 4B 

8005R 

OB 

CYCLE  M 

-10343 

-IB 

2  7B 

DECREMENT  NAME 

-18 

8005R 

OR 

-10543 

-IB 

1000B 

278 

INCREMENT  NAME 

-8B 

8005B 

OB 

CYCLE  M 

-2000000B 

OB 

REW  7-B1 

805  5  B 

18 

9B 

20B 

COMMENT 

EXIT  «- 

K  INV  —  MATRIX  NUMBER  =  1*1000  +  J 
PRINTING  Of  K  INV  IS  COMPLETE 
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8000B 

200P 

29B 

CLEAR  200  CELLS 

8200B 

OB 

LOAD+EXECUTE 

-lOOOOOOB 

OB 

REW  1 

- 8000000B 

OB 

REW  8 

- 16000000B 

OB 

REW  16 

-  110000008 

OB 

REW  11 

9000B 

OB 

PARTITION 

1000000B 

8000B 

OB 

READ  PARAMETERS 

8000B 

8000000B 

OB 

COPY  PARAMETERS 

8000000B 

OB 

EOF 

1 002000B 

OB 

FS/F2/M0  TO  READ 

lOOOOOOB 

IB 

OB 

READ  S2 

IB 

1 1 OOOOOOB 

OB 

STORE  S2 

— 2B 

8003B 

08 

CYCLE  N  TIMES 

1 lOOOOOOB 

OB 

EOF 

-4B 

8007B 

OB 

CYCLE  J  TIMES 

-1 lOOOOOOB 

OB 

REW  11 

- 1002000B 

OB 

BS/F2/M0  TO  READ 

1 lOOOOOOB 

IB 

OB 

READ  S2 

160000  OOB 

2B 

OB 

READ  K22- l*K2 l 

ie 

2  B  3B 

6B 

MULTIPLY 

3B 

IB 

OB 

COPY 

1004B 

999B 

OB 

11000000B 

23 

OB 

READ  S2 

160000008 

38 

OB 

READ  K22- 1 *K2 1 

2B 

3B  IB 

30B 

MULTI  PLY 

-3B 

80038 

OB 

CYCLE  N-l  TIMES 

lOOOOOOB 

2B 

OB 

READ  SI 

2B 

IB  2B 

2B 

SUBTRACT 

2B 

8000000B 

OB 

STORE  SR 

-11001000B 

OB 

BS/F1/M0 

-136 

8005B 

OB 

CYCLE  M  TIMES 

-  16000000B 

OB 

REW  16 

1 1001000B 

OB 

FS/F1/M0 

-16B 

8007B 

OB 

CYCLE  J  TIMES 

8000000B 

OB 

EOF 

—  1 1 OOOOOOB 

OB 

REW  11 

-8000000B 

OB 

REW  8 

- lOOOOOOB 

OB 

REW  1 

8160  B 

IB 

9B 

20B 

PRINT  COMMENT 

EXIT 

PHASE  P  IS  COMPLETE 

8000B 

100B 

29B 

8100B 

OB 

LOAD 

- 8000000B 

OB 

9000B 

OB 

PARTI TION 

8000000  B 

8000B 

OB 

READ  PARAMETERS 

8001000B 

08 

8075B 

9B 

19B 

PRINT  TITLE 

800000  OB 

IB 

OB 

READ  S  REDUCED 

1014B 

IB 

2  7B 

PREPARE  NAME 

IB 

IB 

1000B 

OB 

IB 

8075B 

20B 

PRINT  S  REDUCED/ 

— 4B 

8005B 

OB 

CYCLE  M 

-1034B 

-IB 

27B 

DECREMENT  NAME 

-IB 

8005B 

OB 

-10548 

-IB 

1000B 

27B 

INCREMENT  NAME 

— 8B 

8007B 

OR 

CYCLE  J 

402 


8055B 

-8000000B 

IB 

OR 

9B  2  OB 

REW  8 
COMMENT 

S  RED  —  MATR 
PR  TNT  I ND  OF  S 

IX  NUMBER  =  1*1000  +  J 
RED  IS  COMPLETE 

EXIT 

8000R 

200B 

29B 

CLEAR  200  CELLS 

8200B 

OB 

LOAD+EXECUTE 

- 3000000B 

OB 

REW  3 

- 1 2000000B 

OB 

REW  12 

-  16000000B 

OB 

REW  16 

-  11000000B 

OB 

REW  11 

9000B 

OB 

PARTITION 

3000000  B 

80008 

OB 

READ  PARAMETERS 

800  0  B 

1 2  OOOOOOB 

OB 

COPY  PARAMETERS 

l 2000000B 

OB 

EOF 

3  002000B 

08 

FS/F2/M0  TO  READ 

300000  OB 

IB 

OB 

READ  S2 

IB 

1 1000000B 

OB 

STORE  S2 

-2B 

8003B 

OB 

CYCLE  N  TIMES 

1 1000000B 

OB 

EOF 

-4B 

8007B 

OB 

CYCLE  J  TIMES 

-  11000000B 

OB 

REW  11 

- 3002000B 

OB 

8S/F2/M0  TO  READ 

110  000  OOR 

IB 

OB 

READ  S2 

16000000B 

2B 

OB 

READ  K22- 1*K21 

IB 

2  B  3B 

68 

MULTIPLY 

3B 

IB 

OB 

COPY 

1004B 

999B 

08 

1 1000000B 

28 

OB 

READ  S2 

1600003  OB 

3B 

OB 

READ  K22- 1*K21 

2B 

3  B  IB 

30R 

MULTIPLY 

-3B 

8003B 

08 

CYCLE  N-l  TIMES 

3000000B 

2B 

OB 

READ  SI 

2B 

IB  2B 

2  B 

SUBTRACT 

2B 

1 2000000B 

OB 

STORE  SR 

-  1 1001000B 

08 

8S/F1/M0 

-13B 

8005B 

08 

CYCLE  M  TIMES 

- 1 6000000B 

OB 

REW  16 

1 1001000B 

OB 

FS/F1/M0 

-16B 

8007B 

OB 

CYCLE  J  TIMES 

1 2000000B 

08 

EOF 

-1  1000000B 

08 

REW  11 

-12000000B 

OB 

REW  12 

- 3000000B 

OR 

REW  3 

8160  B 

IB 

98 

20B 

PRINT  COMMENT 

EXIT 

PHASE  B  IS  COMPLETE 

8000B 

100B 

29B 

81008 

OB 

LOAD 

- 12000000B 

08 

9000B 

OB 

PARTITION 

120000008 

8000B 

OR 

READ  PARAMETERS 

8075B 

9B 

19B 

PRINT  TITLE 

120000  OOB 

IB 

OB 

READ  S  REDUCED 

1014B 

IB 

27B 

PREPARE  NAME 

IB 

IB 

1000B 

OB 
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IB 

8075B 

2  OB 

PRINT  S  REDUCED 

-4B 

8005B 

OB 

CYCLE  M 

-1034B 

-IB 

27B 

DECREMENT  NAME 

-IB 

8005B 

OB 

-1054B 

-  IB 

10003 

27B 

INCREMENT  NAME 

— 8B 

8007B 

OB 

CYCLE  J 

- 1 2000000B 

OB 

REW  12 

905  5  B 

IB 

9B 

2  OB 

COMMENT 

EXIT 

5  RED  — 

MATRIX  NUMBER  =  1*1000  +  J 

PR  INTING 

OF  S  RED  IS  COMPLETE 

$EOF 
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APPENDIX  IV 


PHASE  II  PROGRAM  LISTING 
This  appendix  contains  the  following  listings: 

Subroutine  Page 

PHASE  II  MAIN  PROGRAM .  406 

SCALE  . ‘  ‘  ‘  415 

TAPOS  .  4jg 

RANLOD  .  4j8 

ARIA  .  422 

CONST  . 423 

NOISOR .  424 

outpt . 426 

PEDAN .  428 

printa  . .!.’!!!!!.’!.’!!! .  431 

PRINTB  .  433 

CONS  . !!!.*! .  435 

PRINTC .  436 

PRINTD .  437 

DSECM1  . 439 

ADMIN3  .  441 

ADDMAT . '  [  . .  443 

admin2  . !!!!!.’!.’!!!!!!  445 

CQJD  .  449 

SUMT . 452 

SUM2  .  453 

SECM3  . ‘  ‘  .  454 

SECM2  . ‘  . .  457 

ADMIT3  . ‘  ‘  ‘  ‘  |  . .  461 

admit2  . !!!!!!!!!!!!!!!!!!  463 

CQCPSD  .  466 

sums . 468 

PRINTE .  470 

dsecm3  . 472 

PHASE  II  TLOl  SUBROUTINES  . [  j  ’][’**  *  473 
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PHASE  II  PROGRAM  LISTING 
PHASE  II  -  MAIN  PROGRAM 


IBFTC  PHASE 2  DECK. 

* 

*  (PHASE  2  ) 

#  RANDOM  RESPONSE 

# 

*  SOLUTION  PROGRAM 

« 

* 

•  R  A  N  V  I  B 


* 

ft 


ft 

* 

* 

ft 


* 

# 


ft 


RANVIB  -  RANDOM  VIBRATION  ANALYSIS  SYSTEM  FOR  COMPLEX  STRUCTURES 
CALCULATES  THE  CROS-POWER  SPECTRAL  DENSITY*  JOINT  MOMENTS 
AND  SPECTRAL  MOMENTS. 


•••  ANALYSIS  OPTIONS  *** 


OPTION  1 

GENERAL  ANALYSIS-ARBITRARY  PRESSURE  SPECTRA  WITH 
VISCOUS  DAMPING. 

OPTION  2 

SIMPLIFIED 

ANALYSIS  WITH  CROSS  TERMS-SLOWLY  VARYING 
PRESSURE  SPECTRA*  WITH  DAMPING 
PROPORTIONAL  TO  A  LINEAR 

COMBINATION  OF  INERTIA  AND 

STIFFNESS  OR  STRUCTURAL  DAMPING. 

OPTION  3 

SIMPLIFIED 

ANALYSIS  WITHOUT  CROSS  TERMS-SLOWLY 
VARYING  PRESSURE  SPECTRA,  CROSS 
TERMS  DELETED.  DAMPING  ASSUMPTIONS 
ARE  SAME  AS  OPTION  2* 

FLG1-1  CALCULATE  OPTION  1 
-2  CALCULATE  OPTION  2 
-3  CALCULATE  OPTION  3 


FLG2-1  CALCULATE  JOINT  DEFLECTION  (  JD  ) 

■2  CALCULATE  CROSS  POWER  SPECTRAL  DENSITY  - 
(  CPSD  > 


FLG3-0  NO  STRESSES  ARE  CALCULATED 
-1  STRESS  ARE  CALCULATED 


FLGA-0  NO  SECOND  MOMENTS  ARE  CALCULATED 
■1  SECOND  MOMENTS  ARE  CALCULATED 


COMMON/ BLK1 /FREQ* AMASS .OMEGA 

COMMON  /BLK2/M,N*G*ALAM.CMU«K.NF .NPLATE  * NBEAMS * NLOOP 
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nnn  n  n  n  a  r*  c\  n  r»  non  n  r%  n 


COMMON /BLK3/FLG1 *FLG2 *FL63  *FLG4*MF *NRI 

DIMENSION  IRROR (5)*B!16)»FREQ(25) * AMASS !  25 ) *OMEGA  1 100 ) 

INTEGER  FLG1*FLG2*FLG3*FLG4 

READ! 3*8888 )  FL61 *  FLG2 *FLG3  *FLG4  tNPLATE  »NBEAMS 
WR I TE ( 6  #  8999 ) 

WRITE! 6*7000 )FLG1 *FLG2*FLG3  *FLG4»NPLATE*NBEAM5 

C 

^•••INITIALIZE  TAPES 

C***NTAP1  -  PHASE  1  DATA  OUTPUT  TAPE 

C*** I  TAPE  -  PHASE  2  MASTER  TAPE 

C***NTAP2*  NTAP3*  NTAP8*  NTAP11 •  NTAP12 •  N TAP  15  -  SCRATCH  TAPES 
NTAP1  -  10 
NT APS  •  3 
NTAP2  •  4 
NTAP8  »  8 
NTAP11  »  11 
ITAPE  -  9 
NT  AP 12  =■  12 
NTAP15  -  15 
C 

C***REW IND  TAPES 

REWIND  NTAP1 
REWIND  NTAP2 
REWIND  NTAP3 
REWIND  NTAP8 
REWIND  NTAP11 
IRELOC  -  0 


•••READ  NATURAL  FREQUENCIES*** 


NAME  «  0 
NMAT  ■  0 
NFILE  ■  2 

CALL  READTP ( FREQ  *  1 *NAME  *M*1»B*NFI LE  *NMAT *NTAP1 *IRR) 
IF  (  IRR  *NE.  0  )  GO  TO  9985 


•••FREQUENC I ES( FREQ  ) 


CONVERT  CYCLES/SEC  TO  RADIANS  BY  MULT  THE 
FREQ  BY  2*PI*WHERE  P I »3 • 14159265 


DO  10  I  ■  1 *M 

10  FREQ ( I )  -  FREQ! I ) *6 • 2831853 


•••READ  GENERALIZED  MASSES*** 


NAME  *  0 
NMAT  -  1 
NFILE  ■  0 

CALL  READTP (AMASS *1 *NAME*1*M *B*NF I LE  *NMAT »NTAP1 * IRR) 

IF  (  IRR  *NE*  0  I  GO  TO  9985 
WR I TE ( 6  *7001 ) 

WRITE <6* 7002) ! I *FREQ ( I ) * AMASS! I) *I«1*M) 

»««  CARD  INPUT  NUMBER  OF  DEGREES  OF  FREEDOM ( N ) 

DAMPING  CON T ANTS ( ALAM* AMU *G) 

AND  OFF  DIAGONAL  CONSTANT  K 

READ ( 5  *9000 )  ALAM *CMU»G *N*K *NF 
WRITE! 6*7003) ALAM*CMU*G*N.K.NF 

«*•  CALL  SUBROUTINE  TO  FORWARD  SPACE  ON  MASTER  TAPE  UNIT  9  TO  START 
READING  THE  CORRECT  TLOl  ROUTINES  • 
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CALL  TAPOS 


C 

C 

C 

C#**  TEST  TO  SEE  IF  FREQUENCIES  FOR  THE  CPSD 

C  CALCULATIONS  ARE  DESIRED 

IF  (  FLG2  .EQ.  2  )  GO  TO  40 
IF  (  FLG1  .EQ.  1  )  GO  TO  40 
GO  TO  50 
C 

C*##  READ  IN  THE  FREQUENCIES (OMEGA) 

C 

40  READ (5.9001)  (  OMEGA < I ) . I ■ 1 » NF  ) 

C 

WR  I T  E ( 6  *  7004 ) 

WR I TE ( 6  *  700  5 )  (  I .OMEGA < I ) . I »1 .NF  ) 

C 

C 

c***  TEST  TO  SEE  IF  OPTIONS  1.2  OR  3  IS  DESIRED 

C 

50  CONTINUE 

C 

GO  TO  (  100.376.300).  FLG1 
100  CONTINUE 

C 


C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

c 

c*** 

c 

c 


* 

# 

*  0  P  T 

* 

* 


CALL  RANLOD 


C 

c 

c 

c 

c 

C*SU8R0UT I NE  PEDAN  IS  CALLED 
CALL  PEDAN 


I  0  N 


* 


# 


1 


# 

* 


FLG1  ■  1  CALCULATE  OPTION  1 

FORM  THE  EXCITATIONS  CO-  AND  QUAD-POWER 
SPECTRAL  DENSITY 


FORM  THE  REAL  AND  IMAGINARY  PART  OF  THE 
MATRIX  TO  8E  INVERTED. 


C 

C#**  FORM  THE  ADMITTANCE  RESPONSE  MATRIX 

C  (COMPLEX  MATRIX  INVERSION  AT  ALL  OMEGAS) 

C 

C*SUBROUT I NE  COMINV  IS  CALLED 

CALL  TLOlt  I  TAP E . I RELOC ♦ I RROR  ) 

I F (  IRROR  .NE.  0  )  GO  TO  9997 


C 

c***  FORM  THE  DEFLECTION  RESPONSE  CPSD 

C 

C*SUBROUT INE  CPSD1  IS  CALLED 

CALL  TL01(  ITAPE.IRELOC. IRROR  l 
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I F (  IRROR  .NE.  0  )  GO  TO  9997 
CALL  PRINTA 


C 

IF  <  FL63  »EQ.  0  )  GO  TO  110 
IF  (  FLG2  .EQ.  1  )  GO  TO  110 
C#SUBROUT I NE  SRESP1  IS  CALLED 

CALL  TLOlt  ITAPE.IRELOC. IRROR  J 
I F (  IRROR  .NE.  0  )  GO  TO  9997 
MR  I TE ( 6 • 9020 ) 

CALL  PRINTB 

110  IF  (  FLG2  .NE.  1  I  GO  TO  1000 
NFILE  -  0 

CALL  FSF (NFILE.IT APE.LERR) 

C 

c 

c 

c***  FORM  THE  INTEGRATION  CONSTANTS  FOR  THE 

C  TRAPEZOIDAL  METHOD  ROUTINE 

C 

CALL  CONS 


C 

C***  FORM  THE  JOINT  DEFLECTION  BY  INTEGRATING 

C  OVER  NF  FREQUENC I ES-COMPLEX  MATRIX 

C  TRAPEZOIDAL  INTEGRATION  ROUTINE. 

C 

C*SUBROUT INE  TRAPM  IS  CALLED 

CALL  TLO 1 (  ITAPEi IRELOC* IRROR  ) 

IF!  IRROR  .NE.  0  )  GO  TO  9997 
CALL  PRINTC 

IF  (  FLG3  .EQ.  0  )  GO  TO  1000 


C 

C***  TEST  TO  SEE  IF  THE  JOINT  STRESS  CPSD  IS 

C  CALCULATED 

C*SU8ROUTINE  SJNT1  IS  CALLED 

CALL  TLOl (  I  TAPE  .  I RELOC  .IRROR  ) 

C 

I F  <  IRROR  .NE.  0  )  GO  TO  9997 
WRITEI6.9010) 

NL  =  2 
NFF  «  1 

CALL  PRINTDINL.NTAP3.NFF) 

C*##  TEST  TO  SEE  IF  THE  DEFLECTION  SECOND 

C  MOMENT  IS  DESIRED. 

IF  (  FLG4  .EQ.  0  )  GO  TO  1000 
CALL  DSECM1 

C*SUBROUT INE  SSECM  IS  CALLED 

CALL  TLOl (  ITAPE.IRELOC.I RROR  ) 


WRITEI6.9011 > 
NL  *  2 
NFF  =  1 


C 

C#**THE  STRESS  SECOND  SPECTRAL  MOMENT  MATRICES  ARE  PRINTED  IN  PRINTD 
CALL  PRINTDINL.NTAP3.NFF) 

GO  TO  1000 


C 

C 

C 

c 

c 

c 


* 

* 
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c  *  0  P  T 

C  * 

c  * 

c 

c 

c 

300  CONTINUE 
NR  I  •  1 

GO  TO  t  310.365  ) *  FLG2 

C*** 

c 

c*** 

c 

310  CALL  RANLOD 

£**• 


3  * 

# 

* 


CALCULATE  JOINT  DEFLECTION-OPTION  3 
CALC  THE  CO-PSD  ONLY 


CALC  THE  ADMITTANCE  INTEGRAL  SCALARS 
CALC  THE  JOINT  DEFLECTIONS 


CALL  ADMIN3 

C##* 

(-•SUBROUTINE  DJNT3  IS  CALLED 

CALL  TLOl (  ITAPE* IRELOC . IRROR  ) 

IF(  IRROR  .NE.  0  I  GO  T°S’’9JHE  J0INT  DEf:LECT  IONS  AT  LIKE  MODES 

NO  =  1 
MF  “  M 

CALL  ADDMAT(NTAP8.NTAP3.NO)t  to  see  if  the  stress  is  desired 

IF  (  FLG3  .EQ.  0  )  GO  TO  1000^^ ^  ^  STRESSES 

C *SUBROUT I NE  SJNT3  IS  CALLED 

CALL  TLOl <  ITAPEiIRELOC. IRROR  ) 

I F (  IRROR  .NE*  0  I  GO  TO  9997 
WRITEI6.9012) 

NL  -  1 
NFF  ■  I 

CALL  PRINTD(NL*NTAP15*NFF) 


£•*# 

c**» 


c 

<;*•* 

C 

<;##• 

C 

C*** 

c 

c 

c*** 

c 


TEST  TO  SEE  IF  THE  DEFLECTION  SECOND 
MOMENTS  ARE  DESIRED 

IF  t  FLG4  .EQ.  0  )  GO  T°C^°°°LATE  THE  DEfLECTION  SECOND  MOMENTS 

CALC  THE  SECOND  MOM  ADMITTANCE  INTEGRAL 
SCALARS 


CALL  DSECM3 

C*** 

c*  SUBROUTINE  DSJNT3  IS  CALLED 

CALL  TLOl!  I  TAPE . I RELOC » I RROR  ) 
IF  (  IRROR  .NE.  0  )  GO  TO  9997 
WRITE! 6*9013) 

NL  «  1 
NFF  =  1 

CALL  PRINTD(NL*NTAP15*NFF> 

GO  TO  1000 


CALC  THE  DEFLECTION  SECOND  MOMENTS 
CALCULATE  THE  DEFLECTION  JOINT  STRESS 


365  CONTINUE 


C»#* 

c»** 


CALL  RANLOD 


***  OPTION  3-DEFLECTION  CPSO  *•* 

FORM  THE  CO-  AND  QUAD-PSD  AT  NF  FREQ. 
FORM  THE  ADMITTANCE  SCALARS-OP T I  ON  3 
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CALL  ADMIT3 

c##*  FORM  THE  DEFLECTION  RESPONSE  PSD 

C*SUBROUTINE  CPSD3  IS  CALLED 

CALL  TL01I  I  TAPE  * IRELOC  » IRROR  ) 

I F (  IRROR  »NE»  0  )  GO  TO  9997 

c#**  SUM  THE  DEFLECTION  RESPONSE  CPSD  FOR 

C  ALL  LIKE  MODES. 

MF  =  M 

CALL  ADDMAT (NTAP8.NTAP3.NF) 

IF  (  FLG3  .EQ.  0  )  GO  TO  1000 

C***  CALCULATE  THE  STRESS  RESPONSE  PSD 

C*SUBROUT I NE  SRESP3  IS  CALLED 

CALL  TLOl (  I  TAPE. IRELOC . IRROR  ) 

I F (  IRROR  .NE.  0  )  GO  TO  9997 
WRITEI6.9014) 

NL  =  1 
NFF  =  NF 

CALL  PRINTDINL.NTAP15.NFF) 

GO  TO  1000 
378  CONTINUE 


*  * 

*  * 

•  OPTION  2* 

.  * 

•  * 


**•  OPTION  2-JOINT  DEFLECTIONS  *** 


C 

380 


C**» 


NLOOP  ■  ( M-l ) *K  -  K*(K-l)/2 

FORM  THE  CO-  AND  QUAD-PSD 

GO  TO  (  380.400  ) .  FLG2 
CALL  RANLOD 
CALL  ADMIN3 

CALL  TL01( ITAPE.IRELOC. IRROR) 

IF  (  IRROR  .NE.  0  )  GO  TO  9997 
NR  I  -  1 
NO  ■  1 
MF  *  M 

CALL  ADDMAT (NTAP8.NTAP3.NO) 

FORM  THE  ADMITTANCE  INTEGRAL  SCALARS 

CALL  ADMIN2 

CALCULATE  THE  EXCITATIONS 


C 

c 


c 

c 


CALL  CQJD 

•  •• 


FORM  THE  JOINT  DEFLECTION  CPSD 


•SUBROUTINE  DJNT2  IS  CALLED 

CALL  TL01I  ITAPE.IRELOC. IRROR  ) 

I F (  IRROR  .NE.  0  )  GO  TO  9997 

*#*  SUM  THE  JOINT  DEFLECTIONS  WITH  ALL  CROSS 

MODES  INCLUDED  WITH  LIKE  MODE  EFFECTS. 


NR  I  *  2 
NO  =  1 


MF  ■  M-l 

CALL  ADDMAT (NTAP8.NTAP2.NO) 
NO  =  1 

CALL  SUMT ( NO .NT AP2 ) 
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C***  SUM  OPTION  2  EFFECT  TO  OPTION  3 

NO  =  2 
NCN  x  1 

CALL  SUM2lNTAP3.NTAP2.NO.NCN) 

##*  TEST  TO  SEE  IF  THE  SECOND  MOMENT  SCALARS 

IN  THE  FATIGUE  LIFE  CALC  ARE  TO  bE 
COMPUTED. 

IF  (  FLG3  .EQ.  0  I  GO  TO  1000 
♦SUBROUTINE  SJNT2  IS  CALLED 

CALL  TL01 (  ITAPE* IRELOC* I RROR  ) 

IF  (  IRROR  *NE.  0  )  GO  TO  9997 
WRITE! 6*9015) 

NL  =  2 
NFF  =  1 

CALL  PRINTDINL.NTAP15.NFF) 

IF  (  FLG4  .EQ.  0  )  GO  TO  1000 
CALL  SECM3 

CALL  TLOl! ITAPE. IRELOC. IRROR) 

IF  (  IRROR  .NE.  0  )  GO  TO  9997 
■NR  I  =  1 
NO  =  1 
MF  =  M 

CALL  ADDMAT (NTAP8.NTAP3.NO) 

♦**  FORM  THE  SEC  MOM  ADM  INT  SCALARS 

CALL  SECM2 

»»*  CALCULATE  THE  EXCITATIONS 

CALL  CQJD 

»#*  FORM  THE  DEFLECTION  SECOND  MOMENTS 

♦SUBROUTINE  DSECM2  IS  CALLED 

CALL  TLOl!  ITAPE. IRELOC.IRROR  ) 

IF!  IRROR  .NE.  0  )  GO  TO  9997 
NR  I  =  2 
NO  =  1 
MF  =  M-l 

CALL  ADDMAT(NTAP8.NTAP2.NO) 

NO  «  1 

CALL  SUMT ( NO  *  NT  AP2 ) 

NO  =  2 
NCN  =  2 

CALL  SUM 2 (NT AP3.NTAP2.NO. NCN) 


SUBROUTINE  SECM2  IS  CALLED 

CALL  TLOl!  I  TAPE . I RELOC ♦ I RROR  ) 

IF  (  IRROR  .NE.  0  )  GO  TO  9997 
WR I TE ( 6 • 90 1 6 ) 

NL  =  2 
NFF  =  1 

CALL  PRINTDtNL .NTAP15 .NFF ) 

GO  TO  1000 
400  CONTINUE 

c  ♦»♦  OPTION  2-CPSD  ♦♦* 

CALC  THE  CO-  AND  QUAD-(PSD  OPTION  2) 

CALL  RANLOD 
CALL  ADM  I T  3 

CALL  TLOl! ITAPE. IRELOC. IRROR) 

IF  (  IRROR  .NE.  0  )  GO  TO  9997 
NR  I  =  1 
MF  =  M 

CALL  ADDMATINTAP8.NTAP3.NF) 
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FORM  THE  ADMITTANCE  SCALARS 


C*** 

CALL  ADMIT2 

£»*•  CALC  THE  EXCITATIONS  FOR  OPTION  2-CPSD 

CALL  COCPSD 

C***  CALC  THE  DEFLECTION  RESPONSE  CPSD 

C*SUBROUTINE  DRESP2  IS  CALLED 

CALL  TLOl (  I  TAPE  » I REL-C  # I RROR  ) 

I F (  IRROR  .NE*  0  )  GO  TO  9997 

C*##  SUM  OVER  ALL  CROSS-MODE  EFFECTS 

NR  I  *  1 
NO  =  2*NF 
MF  =  M-l 

CALL  ADDMAT (NTAP8#NTAP2*NO) 

NO  »  NF 

CALL  SUMT (NO*NTAP2l 

*##  SUM  THE  CROSS-MODE  EFFECTS  TO  OPTION  3 

LIKE  MODES  TO  GET  THE  TOTAi.  DEFLECTION 
RESPONSE  CPSD 

WRITE<6*9018  > 

CALL  SUM 3 (NTAP3»NTAP2*NTAP8) 


TEST  TO  SEE  IF  THE  STRESSES  ARE  DESIRED 
IF  (  FLG3  .EQ.  0  )  GO  TO  1000 
C**#  CALCULATE  THE  STRESS  RESPONSE  CPSD 

C#SUBROUT I  ME  SRESP2  IS  CALLED 

CALL  TLOl (  ITAPEtIRELOC* IRROR  ) 

I F  <  IRROR  .NE.  0  )  GO  TO  9997 
WRITE(6*9017) 

CALL  PRINTE 
C 

GO  TO  1000 

9985  WR I T  E ( 6  *  9990 )  IRR 
RETURN 

9997  WRITE<6*9998) 

WR I TE ( 6  *  9999 )  IRROR 
1000  CONTINUE 

WRITE(6*9019) 

CALL  UNLOAD ( NTAP 1 ) 

RETURN 

7000  FORMAT! 1  HO  * 16HOPT ION  CONTROLS  7HFLAG  1=12  » 5X  *  7HFLAG  2=I2»5X. 
17HFLAG  3  =  1 2 i 5X  » 7HFLAG  4= I  2 . 5X * 7HNPL ATE= 1 4 , 5 X  * 7HNBEAMS= 1 4/ // ) 

7001  FORMAT! 1 OX »32HNATURAL  FREQUENC I ES ! R AD  I ANS/SEC ) * 10X * 18HGENERAL I  ZED 
1MASSES//  ) 

7002  FORMAT (20X*I5*5X*E14»7*10X*E14»7) 

700  3  FORMAT ( 1  HO • 7HLAMBDA  =  F 1 2 .6 * 5X  » 3HMU  =  F 1 2 . 6  * 5X • 2HG«F 12 . 6 . 5X  •  2hN=  I  5  « 


15X  »2HK  = 

7004  FORMAT! 

7005  FORMAT! 
8888  FORMAT! 

8999  FORMAT! 
1UCTURES 

9000  FORMAT! 

9001  FORMAT! 

9010  FORMAT! 

9011  FORMAT! 

9012  FORMAT! 

9013  FORMAT! 
1  //// 

9014  FORMAT! 


I5*5X*3HNF=I5////) 

1H1.31HCROSS-PSD  FREQUENCIES! RAD/SEC) 
1X*I5*5X»E14.7) 


///) 


6110) 

1H1»25X»74HRAND0M 
(  R  A  N  V  I  B 
3F10. 0*3110  ) 
7F10.0) 

1H1*40X*26HSTRESS 

1H1»40X*38HSTRESS 

1H1*40X*38HSTRESS 

1H1*40X*49HSTRESS 

) 

1H1* 40 X*25HS TRESS 


VIBRATION 
////  ) 


ANALYSIS  SYSTEM  FOR  COMPLEX  STR 


COVARIANCE  MATRICES  ////) 

SECOND  SPECTRAL  MOMENT  MATRICES  ////) 
COVARIANCE  MATRICES  (REAL  PART)  ///) 
SECOND  SPECTRAL  MOMENT  MATRIX  (REAL  P’AR T ) 

CROSS  PSD  MATRICES  ///) 
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9015  F0RMAT!1H1*40X#26HSTRESS  COVARIANCE  MATRICES  ////) 

9016  FORMAT ( 1  Hi • 40X * 39HSTRESS  SECOND  SPECTRAL  MOMENT  MATRICES  III/) 

9017  FORMAT ( 1  HI  * 40X ♦ 25HSTRESS  CROSS-PSD  MATRICES  ////) 

9018  FORMAT! 1H1 » 40X ♦ 30HDEFLECT ION  CROSS  PSD  MATRICES  ////) 

9019  FORMAT! 1H0«30X*58H  RANVIB  PROGRAM  IS  COMP 
1L  E  T  E  D  ) 

9020  FORMAT ! 1H1 *40X *25HSTRESS  CROSS-PSD  MATRICES  III/) 

9990  FORMAT ( 28H  ERROR  IN  READTP-ERROR  C0DE*I5) 

9998  FORMAT ! 104H  5  INSTRUCTION  FIELDS  OF  THE  CARD  THAT  TL01  WAS  TRYING 
1T0  INTERPRET  AT  THE  TIME  AN  ERROR  WAS  ENCOUNTERED  > 

9999  FORMAT!  5!5X#I10)  ) 

END 
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SUBROUTINE  SCALE 


SlBFTC  SCALE*  DECK 

SUBROUTINE  SCAL E ( FREQ .NFREQ* SCAL) 
SUBROUTINE  TO  CALCULATE  THE  ADMITTANCE 
AND  scale  THE  FREQUENCIES 
»**  FREQ-THE  SCALED  FREQUENCIES 
»**  NFREQ-NO  OF  FREQUENCIES 
»•*  SCALE-THE  SCALE  FACTOR 


INTEGRAL  SCALE  FACTOR 


EXAMINING  THE  MAGNITUDE 


crA,  SCALING  FACTOR  •  DETERMINED  BY  - . ---- 

OF  THE  FIRST  NATURAL  FREQUENCY.  THIS  ROUTINE  WILL  °NCY 
SCALE  FREQUENCIES  IN  THE  RANGE  OF  10  T“  0  !°  0  '  AFT£I! 

THE  SCALING  FACTOR  IS  FOUND  ALL  FREQ.  WI LL  BE  SCALED. 
♦♦•♦(FREQUENCY  RANGE)*  *************  *SCALE  FACTOR 

0  TO  100  INCLUSIVE  *® 

GREATER  THAN  100  AND  LESS  THAN  OR  EQUAL  TO  ItOOO 
GREATER  THAN  1.000  AND  LESS  THAN  OR  EQ  TO  10*000 
GREATER  THAN  10.000  AND  LESS  THAN  OR  EQ  TO  100.000  10.000 


AFTER  THE  QUOTIENT  HAS  BEEN  FOUND  THE  RESULT  IS  DIVIDED 
BY  THE  SCALE  FACTOR  CUBED  TO  OBTAIN  THE  CORRECT  ^SULTS. 
THIS  ROUTINE  WILL  SCALE  THE  FREQUENCIES.  THERE  WILL  BE 
AN  OVERFLOW  IN  THE  CALCULATIONS  OF  THE  ADMITTANCE 
INTEGRALS  IF  THE  FREQUENCIES  ARE  NOT  SCALED. 


DIMENSION  FREQ ( 1 ) 

DO  100  1-2.5 
P-10**I 

IF(FREQ( 1)-P  >20.20.100 
20  SCAL  =  P/10. 

GO  TO  200 
100  CONTINUE 
200  DO  300  I-l.NFREQ 
300  FREQ ( I )  -  FREQ ( I ) /SCAL 
RETURN 
END 
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SUBROUTINE  TAPOS 


SIBFTC  TAPOS*  DECK 

SUBROUTINE  TAPOS 

COMMON  /8LK3/FLG1*FLG2*FLG3*FLG4 
INTEGER  FLG1*  FLG2*  FLG3.  FLG4 

C 

C 

C  SUBROUTINE  TO  POSITION  TO  THE  START  OF  THE  TLOl  ROUTINES 

C  ON  THE  MASTER  TAPE  UNIT  9  FOR  THE  JOINT  DEFLECTIONS  AND 

C  CROSS  POWER  SPECTRAL  DENSITY  CALCULATIONS  FOR  OPTIONS  It  2t 

C  AND  3  • 


C 

C 


c 

FLG1 

= 

l 

OPTION  1 

c 

e 

2 

OPTION  2 

c 

s 

3 

OPTION  3 

c 

c 

c 

FLG2 

a 

1 

JOINT  DEFLECTIONS 

c 

■ 

2 

CROSS  PSD 

c 

c 

c 

FLG3 

B 

0 

NO  STRESSES 

c 

■ 

1 

STRESSES 

c 

c 

c 

FLG4 

s 

0 

NO  DEFLECTION  SECOND  MOMENTS 

c 

■ 

1 

DEFLECTION  SECOND  MOMENTS 

c 

c 

C  ROUTINE  FSF  IS  USED  TO  DO  THE  FORWARD  SPACING  OF  THE  NUMBER 

C  OF  FILE  MARKS  . 

C 

C 

C 

ITAPE  *  9 

GO  TO  (  100*  200*  300  ) *  FLG1 

***  OPTION  1 

100  GO  TO  (  10*  20  ) •  FLG2 
10  NFILE  =  S 
GO  TO  500 
20  NFILE  »  5 
GO  TO  500 

***  OPTION  2 

200  GO  TO  t  210*  220  ) *  FLG2 
210  NFILE  »  3 
GO  TO  500 
220  NFILE  ■  4 
GO  TO  500 


**  0  P  T  I  0  N  3 

300  GO  TO  I  310.  320  )•  FLG2 
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310  NFILE  ■  1 
GO  TO  500 
320  NFILE  ■  2 

500  CALL  FSF  I  NFILE*  ITAPE*  LERR  ) 
RETURN 
END 
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SUBROUTINE  RANLOD 


S I BFTC  ranlo*  deck 

SUBROUTINE  RANLOD 

FORCE  CROSS  POWER  SPECTRAL  DENSITY  GENERATION  PROGRAM 


DEFINITION  OF  OPTION  FLAGS  IN  COMMON  BLK3 
FLG1  -  1  SOLUTION  OPTION  1 

-  2  SOLUTION  OPTION  2 

■  3  SOLUTION  OPTION  3 

FLG2  »  1  JOINT  DEFLECTIONS 

-  2  CPSD 

FLG3  AND  FLG4  ARE  NOT  USED  IN  THIS  PROGRAM 
MISCELLANEOUS 

NFREO  ■  NO.  OF  NATURAL  FREQUENCIES 
NRTNDS*  NO.  OF  D.O.F.  (RETAINED  NODES) 

KDIG  ■  NO.  OFF  DIAGONAL  TERMS  DESIRED 
NF  -  NO.  OF  SELECTED  CPSD  FREQUENCIES 
COMMON /BLK1 /FREQ  * AMASS  * OMEGA 
COMMON /BLK2/Nf REQ.NSIZE  »G » ALAM • CM. KDIG * NF 
COMMON /BLK3/FLG1 *FLG2*FLG3*FLG4 

COMMON /BLK4/ I T5  * I T6  *  I  TAPE  * JTAPE . I F I LE  *  I  MAT  » I RR .NAME  *ND IM.C 

COMMON /BLK5/N1 *N2*CRD1*CRD2*AREA*IPT 

COMMON/BLK6/PHI .CF.QF 

INTEGER  FLG1*FLG2#FLG3*FLG4 

DIMENSION  FREQ  I  25 )» AMASS (25 ) *OMEGA< 100) 


DIMENSION  IPT(4) »CRD1( 100) *CRD2( 100) » AREA (100) *PHI (100) 

DIMENSION  CF(85»85)*QF(85#85)*C(12) 

DIMENSION  TITLEI14) 

**************************  TAPE  AND  I/O  INITIALIZATION  SECTION  #*■**#»**** 
I3FLG  ■  0 
IT5  -  5 
IT6  -  6 
ITAPE  -  17 
JTAPE  =  14 
IFG  =  FLG2 

IF  (  FLG1  .EQ.  1  )  FLG2  ■  2 

IFILE  -  0 
IMAT  =  0 
IRR  *  0 
NAME  =  0 
NDIM  =  85 

*  SPECIAL  HANDLING  IS  REQUIRED  FOR  OPT.  2 
ASK  QUESTION  -  IS  THIS  OPTION  2 
IF  (FLG1.NE.2)  GO  TO  19 


I3FLG  -  2 
FLG1  -  3 

OPTION  3  IS  DONE  FIRST*  THEN  OPTION  2  .DIFFERENT  TAPE 
SETUP  REQUIRED  FOR  J.D.  AND  CPSD 

19  IF  (FLG1-1)  40*40*20 

20  IF  (FLG1-2)  30*30*40 

30  REWIND  JTAPE 

IF  (FLG2-1)  40*40*50 

40  REWIND  ITAPE 
50  IF  (I3FLG-2)  55*55*53 

53  IF  ( FLGZ-2 )  80*210*210 
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55  READ (ITS  » 1000 )  TITLE 

************************  INPUT  DATA  SECTION 


READ ( I T5  •  1001 ) 
READ ( I T5  ♦  1002 ) 
READ! IT5il001) 
READ ( I T5  *1002 ) 
READ! I T5  *  1002 ) 
IT-  IPT(l) 

GO  TO  160*70) i 


( IPT< I ) *1-1*6) 
D*CX*CY 
N1  *N2 

( CRDI ( I ) *1-1 *N1 ) 
(CRD2U)  *1-1  *N2  ) 

IT 


READ  AREAS 

60  READ ( I T5  •  1002 )  ( AREA(I) *1-1 .NSIZE) 

GO  TO  80 


CALCULATE  AREAS 


70  CALL  ARIA 

COMPUTE  NO.  OF  FREQS  FOR  LIMIT  ON  READING  PHI *S 

80  GO  TO  (100*90) *  FLG2 

CPSD  SOLUTION-NO.  OF  FREQUENCIES  EQUAL  NF 

90  ILIM  ■  NF 
GO  TO  130 

JOINT  DEFLECTION  SOLUTION 
100  GO  TO  ( 110*110*120) .FLG1 

110  ILIM  «  (NFREQ-1 )*KDIG  -  ( XDIG* ( KDIG-1 ) > /2 

GO  TO  130 
120  ILIM  -  NFREQ 

130  READ( I T5  *1002 )  ( PHI ( I ) *  I - 1  *  I LIM ) 

IF  (I3FLG  -  2)  131*131*135 


****#M******************  PRINT 


INPUT  SECTION 


131  WR I TE ( IT  6*2000 ) 

WRITE! IT6*2001) 

WRITE! IT6. 2002)  TITLE 
WRITE! IT6.2003) 

WRITE! I T 6 * 2004 ) ( I PT ( I ) *  I - 1  * 4 ) 

WRITE! IT6*2005)D.CX.CY 
WRITE! IT6*2006)  N1*N2 
WRITE! IT6*2007) 

WRITE! IT6*2008  ) (CRDI! I ) *  I -1 »N1 > 

WRITE! IT6*2009) 

WRITE! IT6*2008 )  ( CRD2 ( I ) *  1-1 *N2 ) 

WRITE! IT6*2010) 

WRITE! I T  6*2008 ) I  AREA ( I ) *  I -1 *NS I ZE ) 

135  WRITE! IT6*2011 ) 

WRITE! I T6 *2008)  < PHI ( I) *  I -1 • I L IM) 
•Hi*********************  CALCULATE  CT  AND  THETA 

FOR  PROGRESSIVE  WAVE 
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IF1I3FLG- 2)  136*136*134 
134  WRITE! IT6*2014) 

GO  TO  210 

136  IF  (  IPT ( 2 ) -1 )  160*160*140 
14C  CALL  CO, NIST  (CX.CYfCT*  THETA) 

WRITE!  IT6*2012  ) 

WRITE! I T  6  *  2  0 1 3  )  CT ♦  THET  A 
REARRANGE  COORDINATES  for  seperation 

160  DO  170  I=1»N1 

CRD1 ( I  ) =CRD1 (  1  +  1  ) 

170  CONTINUE 

DO  180  I  =  1  *  N  2 
CRD2 ( I ) =CRD2 ( I+i ) 

180  CONTINUE 

N 1  =  N 1  “  2 
N2  =  N2  -  2 


-AL^ULATION  I  N 


ASSURE  THE  FRlOuENCIES  ARE  STORED  IN  OMEGA 

I  F  (  FLG2~1  )  190*1 90  #^.10 

190  DO  200  1  =  1  *  NFREO 
OMEGA ( I ) =  FREG (  I  ) 

200  CONT I NUE 

SET  Ur  TO  CALL  GENERATION  ROUTINE  —  NCISCR 
IS  THIS  A  JOINT  DEFLECTION  OPTION  2  SOLUTION 


210 

GO  TO(220*24C)*  FLG2 

YES  - 

JOINT  DEFLECTION 

220 

GO  TO ( 240  *230  *250  ) •  FLG1 

YES  - 

OPTION  2 

230 

I  L  I  Vi 

=  NFREO  -  1 

KLIM 

=  0 

GO  T  0 

260 

2  40 

KLIM 

=  NF 

I  L  I  M 

=  1 

GO  TO 

260 

250 

I  L  I M 

=  1 

KLIM 

=  NFREO 

260 

WRITE 

(  IT6*20io ) 

CALL 

NO  I SOR ( I L I M  *  KL I M  *  D  *  CT *  T H  E 

T  A  *  CX 

»CY) 

K-  -K  #  # 

vc  /f  vc  vc  vc  vr 

*  *  *  *  *  *  *  *  "  *  ::  *  *  *  *  *  CLOSE 

OFF 

tape 

GO  TO  (280*  270*  280)*FLGi 
270  END  FILE  JTA.PE 
REWIND  JTAPE 
GO  TO  (280*290  )  *  FLG2 
2S0  END  FILE  ITAPE 
R  EW I ND  ITAPE 

290  IF  (  I  3 FL G— 2 ) 3 2 0  *  3 1 0  » 32 0 

<;*****#  IF  THIS  IS  AN  OPT  2  SOLUTION* 
310  FLG1  =  2 

ITAPE  =  2 
I 3FLG  =  3 


THE  PROGRAM  MUST  ai 


i  'i  C  I  3  i  \ 


RECYCLE 
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GO  TO  19 

320  IF  <  FLG1  .EQ.  1  )  FLG2  -  IFG 
WRITE! IT6.2015 ) 

RETURN 


########*##*##*#**#***##  INPUT  FORMATS  ********************* 

1000  FORMAT (14A6) 

1001  FORMAT (7110) 

1002  FORMAT  ( 7F 10»  0 ) 

************************  output  formats  ******************* 


2000  FORMAT(1H1.50X*28HRANDOM  LOADING  MODULE  OUTPUT///) 

2001  FORMAT < 1H0 * 86HF0RCE  CROSS  POWER  SPECTRAL  DENSITY  FOR  DECAYED  PROGR 
1ESSIVE  WAVES  FOR  USE  WITH  PANEL  -  ) 

2002  FORMAT ( 1H  »14A6///) 

2003  FORMAT  (  1H0*  55X#18H, I  N  P  U  T  DAT  A//) 

2004  FORMAT (1H0*104HTHE  FOLLOWING  FOUR  OPTIONS  HAVE  BEEN  SELECTED  (THEY 
1  APPEAR  IN  THE  ORDER  IN  WHICH  THEY  WERE  CARD  INPUT)  -// IX . 16HOPT 1 0 
2N(S)  (1)  =  *12*  8H  (2)  ■  1 1 2  *  8H  (3)  =  *12. 8H  (4)  =  .12/) 

2005  FORMAT! 1H0.28HPARAMETER  VALUES  ARE  -  D  =  .E15.8/24X.  5HCX  «  »E15. 
18/24X*  5HCY  =  *E15.8/) 

2006  FORMAT ( 1H0  *  66HNUMBER  OF  COORDINATES  IN  THE  DIRECTION  OF  CYCLIC  NO 
IDE  NUMBERING  -  .I3/1X.  94HNUMBER  OF  COORDINATES  IN  THE  DIRECTION  - 
2ERPENDICULAR.TO  THE  CYCLIC  NODE  NUMBERING  DIRECTION  -  ,13/) 

2007  FORMAT ( 1H0  *  60HOR I G I N-TO-NODE  LINE  DISTANCES  IN  THE  CYCLIC  DIRECTI 
ION  ARE  -  ) 

2008  F0RMAT(1H0.6E16.7/(E17.7*5E16.7) ) 

2009  FORMAT ( 1H0  *  74H0R IGIN-TO-NODE  LINE  DISTANCES  PERPENDICULAR  TO  THE 
1CYCLIC  DIRECTION  ARE  -  ) 

2010  FORMAT ( 1  HO. 42 HA REA  ASSOCIATED  WITH  EACH  RETAINED  NODE  -  ) 

2011  FORMAT! 1H0 ,40HPRESSURE  POWER  SPECTRAL  DENSITIES  ARE  -  ) 

2012  FORMAT ( //1H0 »28H*****C0MPUTED  CONSTANTS*****) 

2013  FORMAT (1H0.38HTRACE  VELOCITY  OF  PRESSURE  WAVE.  CT  =  . E15 .8/ IX ,66HA 
INGLE  BETWEEN  TRACE  WAVE  PROPAGATION  DIRECTION  AND  X-AXIS.  THETA  - 


2.E15.8) 

2014  FORMAT ( ///1H0 » 102H*****  THIS  IS  AN  OPTION  2  SOLUTION  - 
10PTI0N  3  APPEAR  ABOVE  FOLLOWED  BY  OPTION  2  BELOW  ***** 

2015  FORMATQHO,  29H****  GENERATION  COMPLETE  ****) 

2016  FORMAT! 1H0.75HTHE  FOLLOWING  FORCE  CROSS  POWER  SPECTRAL 
1RICES  WERE  GENERATED  -  ) 

END 


RESULTS  OF 
) 

DENSITY  MAT 
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SUBROUTINE  ARIA 


SlBFTC  ARIA**  DECK 

SUBROUTINE  ARIA 

THIS  ROUTINE  CALCULATES  THE  NODAL  AREAS  FOR  THE  RETAINED 
NODES  IN  A  RECTANGULAR  PANEL  CONFIGURATION.  THE  GRID  CAN 
HAVE  UNEQUALLY  SPACED  COORDINATES  IN  EITHER  OR  BOTH  THE 
X  AND  Y  DIRECTION.  THE  COORDINATE  ORIGIN  CAN  BE  (0.0)  OR 
(XO.YO). 


1. 


2. 

3. 

4. 

5. 


DESCRIPTION  OF  CALLING  SEQUENCE 
X-ARRAY  THE  SET  OF  X-COORDINATES  FOR  THE  RETAINED 
CRD1  NODES#  WHERE  X(l)  AND  XILAST)  ARE  THE 
BOUNDARY  VALUES  -INPUT 

Y-ARRAY  THE  SET  OF  Y-COORD I  NAT ES  CORRESPONDING  -INPUT 
CRD2  WITH  X  -  INPUT 

NX-N1  THE  NUMBER  OF  RETAINED  NODES  IN  THE  X-DIRECTION 

NY-N2  THE  NUMBER  OF  RETAINED  NODES  IN  THE  Y-DIRECT ION 

AREA  THE  SET  OF  AREAS  FOR  RETAINED  NODES  -  OUTPUT 


L  IS  A  COUNTER  L= 1 » NO.  OF  RETAINED  NODES  «  NX*NY 

COMMON/BLKI/FREQ  » AM ASS# OMEGA 

COMMON / B LK2 /NF  REQ » NS  1 2E  #G* ALAM » CM# KDIG #NF 
COMMON / BLK3/F LG 1 »FLG2#FLG3#FLG4 

COMMON/ BLK4/ 1 T5  » I T6 » I  TAPE • JTAPE • IF  I LE# I MAT » I RR  #NAME #NDIM»C 
COMMON /BLK5/N1 «N2#CRD1 #CRD2 » AREA » IP T 
COMMON/3LK6/PHI #CF#QF 
INTEGER  FLG1#FLG2#FLG3*FLG4 
DIMENSION  FREQ ( 25  I ♦ AMASS (25 ) #OMEGA< 100) 

C 

DIMENSION  IPTU ) #CRDl (100) #CRD2 ( 100  )# AREA ( 100 ) #PHI (100) 
DIMENSION  CF(85.85) #QF( 85*85) *C( 12) 

L  ■  0 

M  ■  N1  -  1 
N  *  N2  -  1 
C 

DO  100  I-2#N 
C 

DELY  -  (  CRD2  ( I  +  l )  *•  CRD2  ( 1-1 )) /4.0 
DO  100  J-  2  #M 
C 

L  ■  L  *■  1 
C 

AREA ( L )  »(CRD1 (J+l)-  CRD1 (J-l ) )*DELY 
100  CONTINUE 
RETURN 
E-D 
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SUBROUTINE  CONST 


$ IBFTC  CONST*  DECK 

SUBROUTINE  CONST(CX.CY.CT. THETA) 

THIS  ROUTINE  CALCULATES  THE  TRACE  VEL0CI ™  ‘CT )  AND 
THETA  -  THE  ANGLE  BETWEEN  DIRECTION  OF  SOUND  PROPAGATION 
AND  X  AND  Y  AXIS  OF  PANEL  IN  THE  CASE  OF  A  PROGRESSIVE 
WAVE.CX  IS  THE  PHASE  VELOCITY  ALONG  PANEL  IN  X-DIRECTION 
CY  IN  Y-DIRECTION. 

CALCULATE  CT. 


IF  <CX)  20.10*20 
C 

10  CT  -  CY 

THETA  -  1.57079 
GO  TO  *100 

20  IF  (CYI  40*30.40 
C 

30  CT  -  CX 

THETA  ■  0.0 
GO  TO  100 

40  THETA  ■  ASINI  1.0/ (SORT! 1.0  ♦  (CY/CX)**2 ) ) ) 
IF  (THETA  -  0.2)  50.50.60 

C 

50  CT  -  CX*COS(THETA) 

GO  TO  100 
C 

60  CT  -  CY*SIN(THETAJ 

100  RETURN 
END 
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SUBROUTINE  NOISOR 


SIBFTC  NO  I  SO*  DECK 

SUBROUTINE  NOISOR ( I L I M . KL IM . D . CT . THE TA , CX . CY ) 

C  SUBROUTINE  NOISOR  SIMULATES  TWO  DIFFERENT  NOISE  SOURCE 

C  CONDITIONS.  (1)  NORMAL  INCIDENCE  WAVES  -  OCCURS  WHEN  THE 

C  TRAIN  OF  WAVE  FRONTS  ARE  PARLLEL  TO  THE  PANEL. 

C  (2)  PROGRESSIVE  WAVE  -  OCCURS  WHEN  THE  TRAIN 

C  OF  INCIDENT  PLANE  WAVE  FRONTS  ARE  NOT  PARALLEL  TO  THE 

C  PANEL  FACE. 

COMMON/ BLK1/FREO. AMASS .OMEGA 

COMMON/BLK2 /NF  REQ  »NS I ZE  .G.ALAM.CM, KDIG »NF 

COMMON/BLK3/FLG1 .FLG2.FLG3.FLG4 

COMMON/BLK4/IT5.IT6. I  TAPE . JT APE . I F I LE . I  MAT . I RR .NAME .ND IM , C 
COMMON/ BLK5/N1 .N2 »CRD1 »CRD2 • AREA . IPT 
COMMON/3LK6/PHI .CF.QF 
INTEGER  FLG1.FLG2.FLG3.FLG4 
DIMENSION  FREC(25).AMASS<25) .OMEGAIlOOl 
C 

DIMENSION  IPT(4) .CRD1 (100) .CRD2( 100 ) .AREA ( 100 ) .PHI ( 100 ) 
DIMENSION  CF(85.85) »QF < 65 . 8 5 ) »C < 12 ) 

CSTHET  =  COS  (  THET A  ) 

SNTHET  =  SIN ( THETA ) 

IF  (CX)  1.2.2 

1  CSTHET  *  -COS ( THETA ) 

2  IF  (CY)  3.4.4 

3  SNTHET  =  -S IN ( THETA ) 

4  IF  < I P  T ( 4 ) -1 )  5.5.6 

5  DUM  =  SNTHET 
SNTHET  =  CSTHET 
CSTHET  =  DUM 

6  NPH I  =  0 

DO  600  L-l.ILIM 
IF  (ILIM-1)  20.20.10 

C  IF  ILIM  -  It  THEN  THIS  IS  NOT  JOINT  DEFLECTION  OPT  2  . 

C 

C  JOINT  DEFL.  OPT.  2 

10  LL  =  L  +  1 

KLIM  «  L  +  KDIG 
IF(KLIM.GT.NFREQ)  KLIM-NFREQ 
GO  TO  30 

C  OUTER  LOOP  =  1 

20  LL  =  1 

30  DO  500  K  -  LL.KLIM 

NPH I  =  NPH I  +  1 
OMEGL  *>  OMEGA  (  L  ) 

IF  ( ILIM-1 )  50.50.40 

40  OMCT  =  (OMEGL  +  OMEGA ( K )) /2 . 0 
GO  TO  60 

50  OMCT  =  OMEGA ( K ) 

60  PHIO  =  PHI ( NPH I ) 

OMG  =  OMCT 
OMCT  =  OMCT / CT 

C  BEGIN  ELEMENT  BY  ELEMENT  MATRIX  GENERATION  -  FORMED  IN  THE 

C  UPPER  TRIANGULAR  AND  TLACE  IN  THE  LOWER 

DO  400  +=  1 .NS I ZE 
ARI  =  AREAU  ) 

DO  300  J-I.NSIZE 
AR  =  ARI*AREA( J ) 
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C  ********* ********»***#»SEPARAT I ON  C ALCUL AT  I  ON********* ###**■****** 

N1J  =  MOO ( J  *N  1 ) 

Nil  =  MOO (  I  *  N 1  ) 

IF  (N1J)  80  #  70  •  80 

70  N2J  =  J/Nl 

N1J  =  N 1 
GO  TO  90 

80  N2J  * J/Nl  +  1 

90  IF  (Nil)  110*100*110 

100  N2I  =  I/Nl 
Nil  =  N 1 
GO  TO  120 

110  N2I  =  I/Nl  +  1 

120  SEP2  «=  CRD2IN2J)  -  CRD2IN2I) 

SEP1  =  CRDKN1J)  -  CRD1  (Nil) 

£******»***#»*»*»»***■  *»■*-**•*******************#***■*»*******»  ************* 

C  CHECK.  IF  A  0 1  AGONAL  ELEMENT 

IF  (I  -  J)  150*130*150 


130  CF ( I  *  J  )  =  AR*PH 1 0 
C  CHECK  IF  QF (  I  ♦  J )  IS  NEEDED 

IF  (FLG1-3)  140  »  300  *  140 
140  QF ( I  * J ) =  0.0 
GO  TO  300 

150  EXYSQ  =  SORT (SEP  1**2  +  SEP2**2 ) 

EXPON  =  EXP ( -D*EXYSQ ) 

C  CHECK  IF  NORMAL  INCIDENCE  OR  PROGRESSIVE  WAVE 

160  IF  ( I P  T ( 2 ) “1 )  180*170*180 

C  NORMAL  INCIDENCE 

170  CP2=  1.0 
GO  TO  190 

C  PROGRESSIVE  WAVE 

180  P2  =  OMCT* ( SEP 1*CSTHET  ♦  SEP2*SNTHET) 

CP2  =  COS<  P2 ) 

190  CF ( I  * J )  *■  AR*PH I 0# EXPON *CP2 
CF ( J  » I )  =  CF ( I  *  J ) 

C  CHECK  IF  QF ( I  *  J )  IS  NEEDED 

IF  ( FLG1  -  3)  200*300*200 

C  CHECK  IF  NORMAL  INCIDENCE  OR  PROGRESSIVE  WAVE 

200  IF  (  I PT ( 2 ) “1 )  220*210*220 

C  NORMAL  INCIDENCE 

210  QF ( I *J)=  0.0 

QF ( J  *  I )=  QF(I.J) 

GO  TO  300 

C  PROGRESSIVE  WAVE 

220  QP2  =  S I N ( P2 ) 

QF ( I  * J )  -  AR*PHI0*EXP0N*QP2 
QF ( J  *  I )  *  -QF ( I *J) 

C 

300  CONTINUE 
400  CONTINUE 

CALL  OUTPUT(NPHI*OMG) 

500  CONTINUE 
600  CONTINUE 
RETURN 
END 
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SUBROUTINE  OUTPT 


sibftc  output  deck 

SUBROUTINE  OUTPT ( NPH I *OMG ) 

THIS  SUBROUTINE  HANDLES  THE  OUTPUT  FOR  EACH  FREQUENY. 

BOTH  THE  PRINTED  OUTPUT  AND  THE  BINARY  TAPES. 

NPHI  IS  THE  CURRENT  FREQUENCY  NUMBER 
COMMON /BLICl /FREQ  » AMASS  * OMEGA 

COMMON/BLK.2/NFREC.NSIZE  .G * ALAM . CM » KDIG » NF 
COMMON /BLK.3/FLG1 .FLG2.FLG3.FLG4 

COMMON /BLK.4/  IT5.IT6.ITAPE  . J T APE • I F I LE . I  MAT  »  I RR  .NAME  »ND  I M  »C 

COMMON/ 6  LK.5/N1  .N2.CRD1 » CRD2  » AREA .  I P T 

COMMON/BLK6/PHI .CF.QF 

INTEGER  FLG1.FLG2.FLG3.FLG4 

DIMENSION  FREQ ( 25 ) .AMASS (25 ) .OMEGA ( 100) 

DIMENSION  IPT (4 ) .CRD1 ( 100) »CRD2( 100) .AREA ( 100) .PHI ( 100 ) 

DIMENSION  CF(85.85).QF(85»85).C(12) 

************************PRlNT  SECT i ON* ********************** *********** 
IF  ( IPTI31-NPHI )  200.10.10 

10  WRITE! IT6*2000)  NPHI.  OMG 
PRINT  CF ( OMEGA ( NPH I )  ) 

DO  20  I ROW  =  1 .NS  1 2E 

WRITE ( I T6* 2001 )  I  ROW. (CFl I  ROW. J) »J«1 .NSI2E ) 

20  CONTINUE 

TEST  IF  QF (OMEGA )  IS  NEEDED-IE  YES  IF  EITHER  OPTION  1  OR  2 
IFIFLG1-2)  30.30.200 

30  WRITE! IT 6.2002 )  NPHI.  OMG 

PRINT  QF (OMEGA (NPHI ) ) 

DO  40  IROW  « 1 . NS  I ZE 

WRITE ( IT6»2001  )  IROW. <  QF ( IROW.J) »J«1.NSIZE) 

************************TAPE  GENERATION  SECT  I  ON****** ******* *********** 

FIRST  DETERMINE  WHETHER  JOINT  DEFLECTIONS  OR  CPSD 

200  I F ( FLG2- 1 )  210.210.  300 

********  JOINT  DEFLECTIONS 

TEST  FOR  OPTION  2  OR  3 

210  IF  (FLG1-2)  220.220*250 

*****  OPTION  2 

220  IFILE  =  0 
I  MAT  =  0 

CALL  WRTETP(CF.NDIM.NAME.NSIZE.NSIZE»C.IFILE.IMAT . I  TAPE . I RR ) 

CALL  WRTETP ( QF . ND I M .NAME .NS I ZE .NSIZE.C.IFILE.IMAT ♦ JTAPE , I RR ) 

GO  TO  500 
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OPTION  3 

250  CALL  WRTETPICF  *ND IM  *  NAME  *NS I ZE  ,N5IZE*C*IFILE*IMAT • I  TAPE# IRR) 
GO  TO  500 


********  CPSO 

TEST  FOR  OPTION  1*2»0R  3 


300  GO  TO  <310*330*350) »  FLG1 


*****  OPTION  1 
310  END  FILE  ITAPE 

CALL  WRTETP(QF*NDIM*NAME*NSIZE*NSIZE*C* IFILE* I  MAT  * ITAPE , IRR) 
CALL  WRTETPICF  *NDIM *NAME *NSI ZE *NSI ZE *C * IFILE* I  MAT  *  I  TAPE  * IRR ) 
GO  TO  500 

*****  OPTION  2 


330 


END  FILE  JT APE 

CALL  WRTETPI CF  * NDI M *N AME *  NS  I ZE *NS I ZE *C * IFILE* I  MAT • JTAPE *  IRR) 
CALL  WRTETPI OF *NDIM*NAME*NSIZE*NSIZE*C. I F I LE *  I  MAT  * JTAPE *  I RR ) 
GO  TO  500 


*****  OPTION  3 
350  END  FILE  ITAPE 

CALL  WRTETP (CF  * NDI M *NAME» NS  I ZE *NSI ZE  *C* IFILE* I  MAT • ITAPE  * IRR ) 
TAPE  WRITING  COMPLETE  -  TAPE  CLOSEOFF  DONE  IN  MAIN  PROGRAM 


TEST  IF  ERROR  FLAG  IRR  HAS  BEEN  SET 

500  IF  <IRR)  510*520*510 
510  WRITE! IT6*2003)  IRR*  FLG1 *FLG2  *NPHI 
CALL  EXIT 
20  RETURN 

****************************F  0  R  M  A  T  S  ***************************** 


2000  FORMAT ( 1H1 *  2X * 14HFREQUENCY  NO.  *  13  * 3X, 14HCF I  I » J ) 
1  8HOMEGA  ■  • E15 . 8// ) 

2001  FORMAT  (1H0,I5*1P6E16»7/(E22»7*5E16.7) ) 

2002  FORMAT  1 1H1,2X,14HFREQUENCY  NO.  ♦  1 3 »3X* 14HQF 1 1  * J ) 
1  8HOMEGA  »  *  El  5 . 8// ) 

2003  FORMAT ( 1  HO  * 2X * 33HERROR  RETURN  FROM  WRTETP  *  IRR 
1  7HFLG1  «  •  1 3*2X*  7HFLG2  •  *I3*2X*  7HNPHI  •=  *13) 

END 


MATRIX, 3X* 

MATR IX  *  3X  * 
-  • 1 3  »  2X • 
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SUBROUTINE  PEDAN 

$IBFTC  PEDAN*  DECK 

SUBROUTINE  PEDAN 


***PEDAN***  IMPEDANCE  MATR  I X ( PEDAN ) 

SUBROUTINE  TO  FORM  THE  REAL  AND  IMAGINARY  PART 

OF  THE  ADMITTANCE  MATRIX  BEFORE  INVERTING 


C*** 

c 

c 


c*** 

c 

c 


c 


COMMON  /BLK1/  FREQ » AM ASS .OMEGA 

COMMON  /BLK2/  M » N »G » ALAM . CMU • K »NF #NPLATE .NBEAMS 

DIMENSION  AMASS! 25 ) • C < 90 . 90 ) . ST  I FF ( 90 • 90 ) .OMEGA! 100) .6! 16  )  . 
1  AMAT (90*90) « FREQ (25) »IPARAM<5) 

DIMENSION  BMASS ( 25 ) 

EQUIVALENCE  (  C. STIFF  ) 

NTAP1  *  10 
NTAP14  =  14 
NTAP15  *  15 
NT API 6  =  16 
REWIND  NT API 
REWIND  N TAP  14 
REWIND  N TAP  15 
REWIND  NTAP16 

FORM  THE  REAL  PART  OF  THE  IMPEDANCE  MATRIX 
*0MEGA**2AMASS( I )  +  STIFF! I. J) 

NAME  =  0 
NMAT  =  0 
NFILE  =  0 

READ  IN  THE  STIFFNESS  MATRIX!  STIFF  ) 

CALL  READTP!STIFF»90*NAME.N.N»B.NFILE.NMAT.NTAP1 . IRR) 

IF  (  IRR  •«  NE  »  0  )  GO  TO  9985 

NAME  =  0 
NMAT  =  0 
NFILE  =  3 

CALL  READTP(BMASS*1»NAME»1*N*B*NFILE .NMAT  *NTAP1*IRR) 

IF  (  IRR  .NE.  0  )  GO  TO  9985 

NAME  =  0 
NMAT  =  0 
NFILE  «=  0 


C*** 

C  START  LOOP  (  NF  TIMES  ) 

C 

DO  200  II  ■  1 »NF 
C 
C 

DO  150  I  -  l.N 
DO  150  J  -  l.N 
IF  (  I  .EQ.  J  )  GO  TO  100 
AMAT! I .J)  •  STIFF! I »J) 

GO  TO  150 

100  AMAT(I.J)  •  -OMEGA! I  I )**2*BMASS< I )  +  STIFF(I.J) 
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150  CONTINUE 
C 

CALL  WRTETP (  AM AT *90  *  NAME »N *N • B*NF I LE *NMAT *NTAP 16 * 1 RR  ) 
IF  (  IRR  #NE.  0  )  60  TO  9986 

C 

200  CONTINUE 


»**READ  IN  THE  DAMPING  MATRIX  C(NXN) 

READ  I  5 *9002)  ( 1 C ( I  * J ) * J“ 1 *N ) *  I  *  1 *N ) 
WRITE16.9003) 

DO  250  I  =  1 *N 

WRITEI6* 90 04)1*1  C(I*J)*J-1»N  ) 

250  CONTINUE 

*#*F0RM  THE  IMAGINARY  PART  OF  THE  IMPEDANCE  MATRIX 
OMEGA*C ( I  * J) 

NAME  =  0 
NMAT  =  0 
NFILE  =  0 

*»# 

START  LOOP 

DO  400  II  ■  1 *NF 


DO  300  I  *  1 *N 
DO  300  J  -  1*N 

300  AMAT(I*J)  ■  OMEGA! I  I >*C1 I *J) 

CALL  WRTETP!  AM AT  *  90  *  NAME *N * N * B *NF I LE *NMAT *NT AP 1 5  *  I RR ) 
CALL  WRTETP!  AMAT *90  *  NAME *N *N * B *NF I LE *NMAT *NTAP 15  *  I RR ) 
IF  (  IRR  *NE.  0  )  GO  TO  9986 

400  CONTINUE 


END  FILE  NTAP15 
END  FILE  NTAP16 


500 

510 


N TAP  15 
N TAP  16 
50 


REWIND 
REWIND 
IF  (  N  .LE* 
I  PAR AM ( 1 )  ■ 
GO  TO  510 
IP  ARAM ( 1 )  * 
I PARAM ( 2 )  - 
I  PAR AM ( 3  )  « 
I PARAM (4)  ■ 
I PARAM { 5 )  ■ 
NAME  =  0 
NMAT  =  0 


)  GO  TO  500 


+  3 


N 

N*N 
NF 
M 

NPLATE 


+  2*NBEAMS 


NFILE  =  0 

CALL  WRTETP!  I PARAM *  1 *NAME *  1  *  5 *B *NF I LE » NMAT .NTAP 14  *  I RR 
IF  (  IRR  .NE.  0  )  GO  TO  9986 
END  FILE  NTAP14 
RETURN 

9985  WR I TE 1 6  » 9990 )  IRR 
CALL  EXIT 

9986  WRITE!6*9991 )  IRR 


) 


9002 

9003 

9004 

9990 

9991 


CAUL  EXIT 


RETURN 
FORMAT ( 
FORMAT ( 
FORMAT ( 
FORMAT ( 
FORMAT ( 
END 


7F10.0) 

1H1 ♦ 40X • 14HDAMP I N6  MATRIX  ////  ) 
1H0iI5.1P7E16.6/(E22.6*6E16.6)  ) 
28H  ERROR  IN  READTP-ERROR  CODE-I 
28H  ERROR  IN  WRTETP-ERROR  CODE-I 


5  ) 
5) 
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SUBROUTINE  PRINTA 
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SUBROUTINE  PRINTA 
C 
C 

C***  THE  DEFLECTION 

ARE  PRINTED. 


CROSS-PSD  MATRICES  FOR  OPTION 


1 


COMMON/ 3 LK1 /FREQ .AMASS* OMEGA 

COMMON /BLK2/M.N .6.ALAM  *CMU*K  »NF .NPLATE.NBEAMS 

DIMENSION  A ( 90  » 90 ) .FREQ (2$) * AMASS! 25 ) .OMEGA ( 100) »B  1 16) 

NT APE  *  15 

ITAPE  =  16 

REWIND  NTAPE 

REWIND  ITAPE 

NAME  =  0 

NM AT  =  0 

NFILE  *  0 

WR IT  E ( 6  »  9000 ) 


*#*CYCLE  ON  NUMBER  OF  FREQUENCIES 
DO  1000  II  ■  l.NF 
WR I TE I  6 . 9005 ) 

WR I TE ( 6 • 9001 )  OMEGA (II) 

CALL  READTP ( A ♦ 90  *  NAME  * N  .  N »B  .NFILE. 
IF  (  IRR  .NE.  0  )  GO  TO  9985 


NMAT.NTAPE.IRR) 


DO  100  I  *  l.N 

WRITE (6 .9002 )I»!A(I.J)*J«1*N) 

100  CONTINUE 

WR I TE ! 6 . 9005 ) 

WR I TE ( 6  »  9003 )  OMEGA(II) 

CALL  READTP ( A . 90 .NAME . N .N  »B. NFILE. NM AT . ITAPE. IRR) 
IF  (  IRR  .NE.  0  )  GO  TO  9985 


DO  200  I  *  l.N 

WRITE (6. 9002) I . (A(I.J) »J“1»N) 
200  CONTINUE 
1000  CONTINUE 


REWIND  NTAPE 
REWIND  ITAPE 
RETURN 
9985  WR I T E ( 6 . 9990 )  IRR 
CALL  EXIT 


RETURN 

9000  FORMAT ( 

9001  FORMAT! 
1//  ) 

9002  FORMAT! 

9003  FORMAT! 
1  ///  ) 

9005  FORMAT! 


1H1.50X.29HDEFLECTI0N  CROSS  PSD  MATRICES  ////) 
1H0.10X.26HDEFLECTION  CO-POWER.  FREQ«E14.7. 12H 

1H0»I5»1P7E16.6/(E22.6.6E16.6)  ) 

1 HO. 10X.28HDEF LECTION  QUAD-POWER*  FREQ-E14.7 . 12H 
1H0 ) 


(RAD/SEC)  / 


(RAD/SEC) 
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9990 


FORMAT ( 28H  ERROR  IN  READTP-ERROR  CODE. 15) 
END 
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SUBROUTINE  PRINTB 
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SUBROUTINE  PRINTB 


•  *« 


THE  STRESS  CROSS-PSD  MATRICES 
PLATES  AND  BEAMS  FOR  OPTION 


ARE  PRINTED  FOR 

1. 


COMMON /BLK1 /FREQ  *  AMASS  * OMEGA 

COMMON /BLK2/M  *N*G*ALAM*CMU*K*NF  .NPLATE .NBEAMS 
COMMON/ BLK3/FLG1 .FLG2.FLG3.FLG4 
INTEGER  FLG1.FLG2.FLG3.FLG4 

DIMENSION  FREQ (25 ) • AMASS <25 ) .OMEGA < 100 ) .S ( 8 .8 ).B(16)»SB(6.6> 

NT  APE  »  3 

REWIND  NTAPE 

NAME  =  0 

NMAT  =  0 

NFILE  =  0 

** I F  NPLATE  EQUALS  0  -  SKIP  PLATE  PRINTOUT 
I F (  NPLATE  •  EQ  *  0  )  GO  TO  200 


DO  100  II  o  1, NPLATE 

WRITE (6*9000)  II 
C 

DO  50  IJ  =  1 *NF 

WR I TE ( 6  *  9001 )  OMEGA ( 1 J ) 

WR I TE ( 6  *  9002 ) 

CALL  READTP(S*8.NAME*NR*NC*B#NFILE*NMAT*NTAPE*IRR) 

IF  (  IRR  *NE.  0  )  GO  TO  9985 
C 

DO  10  I  =  1.8 

WRITE( 6*9003) I *(S(I.J)*J-1*8) 

10  CONTINUE 
C 

WR I TE ( 6 . 9004 ) 

CALL  READTPIS.B .NAME.NR.NC.B.NFILE.NMAT.NTAPE. IRR) 

IF  (  IRR  .NE.  0  )  GO  TO  9985 

DO  20  I  =  1*8 

WRITE (6 *900  3) I  *  <S< I *J) .J-1.8) 

20  CONTINUE 
C 

50  CONTINUE 
C 
C 

100  CONTINUE 
C 
C 
C 

C***IF  NBEAMS  EQUALS  0  “  SKIP  BEAM  PRINTOUT 
200  I F ( NBEAMS  • EQ*  0  )  RETURN 
C 
C 
C 
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DO  1000  II  =  1*NBEAMS 
WR I TE ( 6  *  900 5 )  II 
C 

DO  150  IJ  «  l.NF 
WRITE(6*9001)  OMEGA ( I J ) 

DO  140  II  -  1*2 

CALL  READTP!SB*6*NAME*NR*NC*B*NFILE*NMAT*NTAPE* IRR) 
IF  (  IRR  ,NE»  0  )  GO  TO  9985 
WRITE(6*9010)  II 
WR I TE  <  6  *  9002 ) 

C 

DO  80  I  =  1*6 

WRITE (6*9011 ) I  * ( SB ( I *J) *J-1*6) 

80  CONTINUE 
C 

CALL  READTP($B*6*NAME*NR*NC*B*NFILE*NMA1 .NTAPE  *  I RR  ) 
IF  (  IRR  «NE«  0  )  GO  TO  9985 
WRITE! 6*9004) 

C 

DO  90  1=1*6 

WRITEI6*9012) I  * ( SB ( I  *  J )  •  J* 1  *  6 ) 

90  CONTINUE 
C 

140  CONTINUE 
C 

150  CONTINUE 


1000  CONTINUE 


9985 


9000 

9001 

9002 

9003 

9004 

9005 

9010 

9011 

9012 
9990 


REWIND  NTAPE 
RETURN 

WR  I  TE ( 6  *  9990 )  IRR 
CALL  EXIT 
RETURN 

FORMAT! 1H0*6HPLATE  13  ) 

FORMAT !5X*10HFREQUENCY=E14«7) 

FORMAT (1H0*15X*9HREAL  PART///) 

FORMAT! 1H0.14X. 15 *8E 14.5/! 20X*8E 14,5 )  ) 
FORMAT ( 1H0*15X*9HIMAG  PART///) 

FORMAT ( 1H0*6H  BEAM  13//) 

FORMAT! 10X*4HEND  13///) 

FORMAT! 1H0*20X. 15 *6E14. 5/ (26X*6E 14,5 )  ) 
FORMAT (1HO*20X*I5*6E14,5/(26X*6E14,5)  ) 
FORMAT ( 28H  ERROR  IN  READTP-ERROR  CODE-15) 
END 
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SUBROUTINE  CONS 
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SUBROUTINE  CONS 


###  routine  to  calculate  the  constants  used  in  the 

TRAPEZOIDAL  INTEGRATION  FORMULA. 


COMMON  /BLK1/  FREQ  *  AMASS .OMEGA 

COMMON  /BLK2/M |N.G. ALAM .CMU.K.NF »NPL ATE  * NBEAMS 

DIMENSION  FREQ (25) .AMASSI25) .OMEGA (100) «X( 100) *H< 100) .C( 100 » 

1  . B ( 16  ) 

EQUIVALENCE  (  OMEGA. X  ) 

C  THE  CONSTANTS  ARE  CO.  Cl. AND  C2  CALCULATED  OVER  THE  TOTAL  INTERVAL. 
NT APE  ■  4 
REWIND  NTAPE 
N2  *  NF  -  2 
NN  =  NF  -  1 
C 

DO  10  I = 1 »NN 
10  H ( I )  -  X(I+1)-X(I) 

C 

C(l)  =  H(l)/2.0 
C ( NF )  ■  HINNJ/2. 

C 

DO  150  I  -  2.NN 

C(  I  )«(H(  I— 1 )  ♦H  (  IM/2. 

150  CONTINUE 
C 

NAME  -  0 
NMAT  ■  0 
NFILE  ■  0 

CALL  WRTETP ( C . 1 .NAME . NF.l.B. NFILE. NMAT. NT APE.IRR) 

IF  (  IRR  *NE.  0  )  GO  TO  9986 

END  FILE  NTAPE 

RETURN 

9986  WR 1 T E ( 6 . 9991 )  IRR 
CALL  EXIT 
RETURN 

9991  FORMAT ( 28H  ERROR  IN  WRTETP-ERROR  CODE-15) 

END 
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SUBROUTINE  PRINTC 


*## 


THE  DEFLECT 
OPTION  1. 


ON  CO-VARIANCE  MATRICES  ARE 


PRINTED  FOR 


C 


100 

C 


C 


200 

c 


9985 


9000 

9001 

9002 

9003 
9005 
9990 


COMMON/BLK2/M*N  *G*ALAM*CMU*K*NF*NPLATE*NBEAMS 
DIMENSION  A  (  90  *  90 ) *  B ( 16  ) 

NTAPE  ■  12 
REWIND  NTAPE 
NAME  =  0 
NMAT  =  0 
NFILE  =  0 
WRITE(6*9000) 

WRITE<6#9001  ) 

CALL  READTP <  A  *  90 *NAME  * N * N *B  *NF I LE  *NMAT  »NT APE  *  IRR  ) 

IF  (  IRR  .NE.  0  )  GO  TO  9985 

DO  100  I  =>  1  * N 

WR I TE ( 6  * 9002 )  I . ( A ( I • J ) * J- 1 . N  ) 

CONTINUE 

WRITE(6»9005) 

WRITE (6. 9003) 

CALL  READTP  < A*90. NAME *N *N  •  B *NF I LE *NMAT *NT APE* IRR) 

IF  (  IRR  «NE*  0  )  GO  TO  9985 

DO  200  I  -  1 i N 

WRITE ( 6*9002 )9 *  <A( I *J>  *J-1*N) 

CONTINUE 

REWIND  NTAPE 
RETURN 

WR I T  E ( 6  *  9990 )  IRR 
CALL  EXIT 
RETURN 

FORMAT(1H1*30X*30HDEFLECTION  CO-VARIANCE  MATRIX  ///) 
FORMAT (1H0*10X*9HREAL  PART  ///) 

FORM AT (1  HO* I  5* 1P7E16<6Z<E22<6 *6E16* 6  )  ) 
FORMAT(1HO*10X*1<*HIMAGINARY  PART  ///) 

FORMAT  QHO) 

FORMAT ( 28H  ERROR  IN  READTP-ERROR  CODE-15) 

END 
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SUBROUTINE  PR  I NTD < I R * NTAPE *NFF ) 

C 

c 

C*«*  THE  STRESS  MATRICES  ARE  PRINTED  FOR 

C  OPTIONS  1,  2  AND  3 

C 
C 

C  ' 

COMMON  /BLK1 /FREQ* AMASS  # OMEGA 
COMMON/BLK2/M,N»G»ALAM,CMU»K»NF»NPLATE»NBEAMS 
COMMON/3LK3/FLG 1  *FLG2»FLG3,FLG4 
DIMENSION  S(8*8 ) *  B l 16 ) *SB ( 6  *6 ) 

DIMENSION  FREQ  <  25 ) • AMASS! 28 ) * OMEGA ( 100) 

INTEGER  FLG1 »FLG2 »FLG3 »FLG4 

REWIND  NTAPE 

NAME  =  0 

NMAT  -  0 

NFILE  *  0 


C 

C 

c 


80 

90 


99 

C 

c 


110 

100 

200 

C 


C 

360 

C 


DO 

800  III  = 

1  , 1  R 

IF 

(  III  • EQ* 

2  )  GO 

TO 

80 

WR ITE ( 6 , 9001 ) 

GO 

TO  90 

WRI 

TE ( 6 , 90 10 ) 

IF 

(  NPLATE  • 

EQ.  0  ) 

GO 

TO  200 

DO 

500  INF  = 

1  »NFF 

IF 

(  NFF  • EQ » 

1  )  GO 

TO 

99 

WRI 

TE 1 6 , 9020 ) 

OMEGA ( 

INF) 

CONTINUE 

DO  100  I  I  «  1 *NPLATE 

CALL  READTP(S*8  *NAME *  NR #NC * B *NFI LE *NMAT  *NTAPE»IRR) 
IF  (  IRR  *NE.  0  )  GO  TO  9985 
WR I TE ( 6  *  9002  )  I  I 
DO  110  I  -  1,8 

WRITE (6*9003) I »  <S< I *J) ,J«1»8) 

CONTINUE 

CONTINUE 

IF  (  NBEAMS  .EQ.  0  )  GO  TO  500 

DO  400  II  «  1 *NBEAMS 
WR 1 TE ( 6  »  9004 )  II 
DO  380  IJ  ■  1,2 
WR 1 TE ( 6  «  9005 ) I J 

CALL  READTP  <  SB*6* NAME, NR* NC*B» NFILE *NMAT  *NTAPE  *  I RR ) 
IF  I  IRR  ,NE,  0  )  GO  TO  9965 
DO  360  I  -  1,6 

WRITE<6» 9006)1, ( SB ( I , J I , J-l , 6  ) 

CONTINUE 


38  0 


CONTINUE 


non  non 


C 

400  CONTINUE 
C 

500  CONTINUE 


800  CONTINUE 


9985 


9001 

9002 

9003 

9004 

9005 

9006 
9010 
9020 
9990 


REWIND  NTAPE 
RETURN 

WR  I T  E ! 6  *  9990 )  IRR 
CALL  EXIT 
RETURN 

FORMAT (1H0#10X*9HREAL  PART  ///> 

FORMAT! 1H0*6HPLATE  13) 

FORMAT <1H0*5X*I5*8E14#5/(11X*8E14»5)  ) 

FORMAT ( 1H0*6H  BEAM  13  ) 

FORMAT !11X*4HEND  13  ) 

FORMAT !20X*I5*6E14»5/!25X*6E14»5)  ) 

FORMAT! 1HO*10X*14HIMAOINARY  PART  ///) 

FORMAT  <1H0#27HSTRESS  CO-POWER*  FRE0UENCY-E14. 7 *9H ! RAD/SEC ) 
FORMAT <28H  ERROR  IN  READTP-ERROR  CODE-15) 

END 


) 
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SUBROUTINE  DSECM1 
C 
C 

C***  THE  DEFLECTION  SECOND  SPECTRAL  MOMENTS  ARE 

C  CALCULATED  FOR  OPTION  1. 

C  THE  JOINT  DEFLECTION  MATRICES  FORMED  IN  SUBROUTINE 

C  DJNT1  ARE  MULTIPLIED  BY  ITS  APPROPRIATE  FREQ*«2 

C  AND  CONSTANTS  AND  SUMMED  TOGETHER  TO  FORM  THE 

C  DEFLECTION  SECOND  SPECTRAL  MOMENTS  MAYRIES 

C  DEFLECTION  SECOND  SPECTRAL  MOMENT  MATRICES 

C  (  REAL  PART  AND  IMAGINARY  PART  )• 

C 

C 

C 

COMMON /BLK1 /FREQ (AMASS (OMEGA 

COMMON/ B  LK.2/M  ( N  #G  i  ALAM « CMU# K  »NF  *NPL  ATE » N6EAMS 

DIMENSION  FREQ (25) * AMASS! 25 ) (OMEGA (100) (AMAT <90(901 (SMAT(90(90) 
1  ( B ( 16 ) 

DIMENSION  C(100) 

NTAP12  =  12 
NTAP4  »  4 
NTAP15  =  15 
NTAP16  =  16 
REWIND  NTAP12 
REWIND  NTAP4 
REWIND  NTAP15 
REWIND  NTAP16 
C 

C#**PRINT  title  headings 

WR I TE ( 6 ( 9000 ) 

NAME  «  0 
NMAT  =  0 
NFILE  ■  0 

CALL  READTPIC(1(NAME(NF(1(B(NFILE(NMAT(NTAP4  dRR) 

IF  (  IRR  #NE •  0  )"  GO  TO  9985 
C 

50  5  I  ■  1 ( N 
DO  5  J  •  1(N 
5  SMAT(I(J)  ■  0. 

C 

NT  APE  «  NTAP15 
C 

C***LOOP  ON  REAL  AND  IMAGINARY 
DO  50  III  -  1(2 

IF  (  III  (EQ(  2  )  NTAPE  -  NT AP 16 

DO  40  II  -  1 (NF 

NAME  *=  0 

NMAT  “  0 

NFILE  -  0 

CALL  READTP (AMAT (90 (NAME (N(N(B (NFILE (NMAT (NTAPE (IRR) 

IF  (  IRR  .NE.  0  )  GO  TO  9985 
DO  20  I  -  1 (N 
DO  20  J  -  1 ( N 

20  SMaT(I(J>  ■  SMATd(J)  ♦  AMAT  ( I  ( J  )*OMEGA(  1 1 )  **2*C(  1 1 ) 

40  CONTINUE 
NAME  -  0 
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NMAT  *  0 
NFILE  «  0 

CALL  WRTETP(SMAT*90*NAME*N*N*B.NFILE*NMAT»NTAP12* IRR) 
IF  (  IRR  *NE.  0  )  GO  TO  9986 
IF  (  III  • EO •  1  )  GO  TO  45 
WR I TE ( 6  *  9005 ) 

WR I T  E ( 6  *  9001 ) 

DO  42  I  »  l.N 

WRITE! 6 *9002) I » ( SMAT ( I *J> *J-1*N) 

42  CONTINUE 
GO  TO  50 

45  WR I T  E  <  6  *  9003 ) 

DO  48  I  -  1 • N 

WRITE (6*9002) I • ( SMAT ( I *J) *J-1*N) 

48  CONTINUE 
50  CONTINUE 


9985 

9986 


9000 

9001 

9002 

9003 
9005 

9990 

9991 


END  FILE  NTAP12 
REWIND  NTAP12 
RETURN 

WR I T E ( 6  «  9990 )  IRR 
CALL  EXIT 
WR I T  E ( 6  *  9991 )  IRR 
CALL  EXIT 
RETURN 

FORMAT ( 1H1*30X*41HDEFLECTI0N  SECOND  SPECTRAL  MOMENT  MATRIX 
FORMAT(1HO*10X*14HIMAGINARY  PART  ///) 

FORMAT (1H0*I5*1P7E16*6/(E22*6*6E16«6) 

FORMAT ( 1H0 * 10X * 9HREAL  PART  ///) 

FORMAT ( 1H0) 

FORMAT (28H  ERROR  IN  READTP-ERROR  CODE> 

FORMAT  <  28H  ERROR  IN  WRTETP-ERROR  CODE¬ 
END 


) 


15) 

15) 


////) 
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SUBROUTINE  ADMIN3 
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SUBROUTINE  ADMIN3 


*  * 

•ADMITTANCE  INTEGRALS* 

#  # 
•USED  IN  FORMING  THE* 

*  # 

•JOINT  DEFLECTIONS  * 

*  * 

(  OPTION  3  ) 


OPTION  3  BROAD  BAND  EXCITATIONS#  DAMPING  COEFFICIENTS  PROPORTIONAL 
TO  A  LINEAR  COMBINATION  OF  THE  MASS  INERTIA  AND  STIFFNESS 
COEFFICIENTS.  (  NO  CROSS  MODAL  COUPLING  IS  INCLUDED  ) 

M  NUMBER  OF  FREQUENCIES.  MASS  AND  MODE  SHAPES 

N  NUMBER  OF  RETAINED  DEGREES  OF  FREEDOM 

G  STRUCTURAL  DAMPING 

ALAM  A  DAMPING  PROPORTIONALITY  FACTOR  PROP.  TO  STIFFNESS 

CMU  A  DAMPING  PROPORTIONALITY  FACTOR  FOR  DAMPING  PROPORTIONAL 

TO  MASS. 

DIMENSION  FREQ ( 25  )  .  AMASS<25)«  AMU<25).  DIAG(25>*  PHIM<25>» 

I  PHI ( 100. 23 ) •  B ( 16 ) tNSTO ( 1 ) 

COMMON  /BLK1/  FREQ.  AMASS 
COMMON  /3LK2/  M »N »G .ALAM . CMU 
COMMON /BLK3/FLG1 .FLG2.FLG3.FLG4 
INTEGER  FLG1.FLG2.FLG3.FLG4 
NTAP1  ■  10 
NTAP11  =  11 
REWIND  NTAP1 
REWIND  NTAP11 


C***FORM  THE  PARAMETER  MATRIX  AND  STORE  ON  TAPE 
NSTO ( 1 )  =  M 
NAME  -  0 
NMAT  «  0 
NFILE  =  0 

CALL  WRTETP ( NSTO. 1. NAME. l.l.B .NFILE. NMAT. NTAP 11. I RR ) 
IF  I  IRR  «NE.  0  )  GO  TO  9986 

DAMPING  FACTOR 


C*** 

c 

10 

c 

c 

£»*• 


15 

18 

20 


DO  10  I 
AMU(I)  ■ 


■  l.M 
CMU  + 


ALAM* FREQ ( 1 1 **2  +  G*FREQ ( I ) 


DIAGONAL  SCALARS  ARE  COMPUTED 

IF  (  FLG1  .EQ.  2  >  GO  TO  15 
WR I TE  <  6 . 9000 ) 

GO  TO  18 
WRITEI6.9002) 

DO  20  I  -  l.M 

DlAG(I)  -  3. 14159265/(2. 0*AMU(I)*FREQ( I )**2*AMASSI Il*»2) 
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WR I TE  <  6  *  9001 )  (  I *D I  AG ( I ) *  I  *  1 *M  ) 

NAME  »  0 
NMAT  >  0 
NFILE  •  0 

CALL  WRTETP(DIAG*1*NAME*1  tM#B#NFILE.NMAT*NTAPU,IRR) 

IF  (  IRR  *NE.  0  )  GO  TO  9986 

NAME  =  0 

NMAT  -  1 

NFILE  ■  2 


*## 


THE  MODE  SHAPES  ARE  READ  IN. 


CALL  READTP ( PHI  *  1 00 » NAME .N » M . B .NF I LE »NM AT . NT AP 1 . I RR ) 

IF  (  IRR  .NE.  0  )  GO  TO  9985 

NAME  =  0 

NFILE  *0 

NMAT  =  0 


C 


40 

50 

C 


9985 

9986 


9000 

9001 

9002 

9990 

9991 


DO  50  J  =  1 *M 
DO  40  I = 1 »N 
PHIMU  )  =  PHI  (  I  ,J> 

CALL  WRTETP (PHI M#1 .NAME *N*1 *B »NF I LE * NMAT »NT AP 1 1 .IRR J 
CONTINUE 


END  FILE  NTAP11 
REWIND  NTAP1 
REWIND  N TAP  11 
RETURN 


WR I TE ( 6  #  9990 )  IRR 
CALL  EXIT 


WR I T  E ( 6  *  999 1 )  IRR 
CALL  EXIT 
RETURN 

FORMAT ( 1  HI »40X  »  20HADMI TTANCE  INTEGRALS 
FORMAT (10X»I5(5X.E14.7  > 

FORMAT (1H1*40X#38HADM I TTANCE  INTEGRALS 
ERROR  IN  READTP-ERROR  CODE 


FORMAT (28H 
FORMAT (28H 
END 


I 

ERROR  IN  WRTETP-ERROR  CODE-I 


////  ) 

(NO  CROSS  TERMS)  ///  ) 
5) 

5) 
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SUBROUTINE  ADDMAT 
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SUBROUTINE  ADDMAT ( 


INTAPE.  OUTAPE.  NO  > 


c 

c 

•  # 

c 

*  M  A 

c 

# 

c 

♦ADDITION 

c 

* 

c 

c 

... 

c 

c 

(MATRIX  SIZE 

c*** 

INTAPE  - 

THERE  ARE  M 

c*** 

c 

OUTAPE  - 

THE  SUM  OF  1 

*  * 

T  R  I  X  * 

# 

ROUTINE  * 

* 

#  #  # 

IS  NXN ) 

NO.  OF  MATRICES  STORED  ON  THIS  TAPE. 
MATRICES  ARE  STORED  ON  THIS  TAPE. 


COMMON/BLK1 /FREQ .AMASS .OMEGA 

COMMON/BLK2/M.N .6 . ALAM . CMU. K .NF . NPL ATE . NBEAMS 
COMMON /BLK3/FLG I »FLG2 »FLG3 .FLG4.MF .NR I 
DIMENSION  SUM (90. 90) »AMAT< 90.90) »B< 16) . I PARAM ( 2 ) 
DIMENSION  FREQ ( 25 ) .AMASS (25 ) .OMEGA ( 100) 

INTEGER  OUTAPE 

INTEGER  FLG1.FLG2.FLG3.FLG4 

REWIND  INTAPE 

REWIND  OUTAPE 

NAME  -  0 


NMAT  ■  0 
NFILE  -  0 
C 

C***FORM  PARAMETER  MATRIX  IPARAM 

I  PAR AM  < 1 )  •  NPLATE  +  2*NBEAMS 
I  PARAM ( 2 )  -  NO 

CALL  WRTETP( IPARAM .1 .NAME. 1.2.B.NFI LE.NMAT. OUTAPE. I RR ) 
IF  (  IRR  .NE.  0  )  GO  TO  9986 
IF  (  FLG1  *EQ.  3  )  GO  TO  5 
GO  TO  8 

5  IF  (  FLG2  .EQ.  1  )  GO  TO  6 
GO  TO  7 

6  WR I TE ( 6 ♦ 900 1 ) 

GO  TO  8 

7  WR I TE ( 6 . 9002 ) 

8  CONTINUE 
C 

c 

DO  500  III  -  1 .NO 
IF  (  FLG1  .EQ.  2  )  GO  TO  11 
IF  (  FLG2  .EQ.  1  )  GO  TO  9 
WR I TE ( 6 . 9003 )  OMEGA ( 1 1 1 ) 

9  CONTINUE 
C 

C*##LOOP  ON  REAL  AND  IMAGINARY 
11  DO  400  IR  -  1 .NR  I 
C 


DO  10  I-l.N 
DO  10  J-l.N 
10  SUM(I.J)  -  0. 

C 

c**#beginning  of  loop  to  sum  m  matrices. 
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c 

c 

c 

00  300  II  -  1 »MF 
NAME  »  0 
NFILE  -  0 
NMAT  «  0 

CALL  READTP(AMAT.90,NAME.N,N,B. NFILE, NMAT, INTAPE, IRR) 

IF  (  IRR  .NE.  0  )  60  TO  9985 
C***READ  IN  A  MATRIX  FROM  INTAPE 
C 

DO  100  I  -  1  »N 
DO  100  J  -  1  ,N 

100  SUM (  I  ,  J )  -  SUM ( I  , J )  +  AMAT(ItJ) 

300  CONTINUE 
C 

C***END  OF  LOOP  TO  SUM  M  MATRICES. 

C 

c 

IF  (  FLG1  . EO.  2  J  GO  TO  360 
DO  350  I  ■  1 *N 

WRITE! 6*9000) I  * (SUM! I , J ) , J- 1  ,N ) 

350  CONTINUE 
C 

360  NAME  =  0 
NFILE  -  0 
NMAT  =  0 

C***WR I TE  THE  SUMMATION  MATRIX  ON  OUTAPE. 

CALL  WRTETP ( SUM , 90.N AM E,N,N,B, NFILE  »NMAT. OUTAPE  .IRR) 

IF  (  IRR  .NE.  0  )  60  TO  9986 
400  CONTINUE 
500  CONTINUE 
C 

c 

END  FILE  OUTAPE 
REWIND  INTAPE 
REWIND  OUTAPE 
RETURN 

9985  WR I TE ( 6 , 9990 )  IRR 
CALL  EXIT 

9986  WR I TE ( 6  »  9991 )  IRR 
CALL  EXIT 
RETURN 

9000  F0RMAT(1H0,I5.1P7E16.6/(E22.6«6E16«6)  ) 

9001  FORMAT (1H1.30X.37HDEFLECTI ON  CO-VARIANCE  MATRIX  (REAL)  ///) 

9002  FORMAT ( 1H1 , 30X , 39H8EL0W  ARE  DEFLECTION  CROSS-PSD  MATRICES  ///  ) 

9003  FORMAT ( 1  HO. 31HD SELECTION  CO-POWER.  F REQUENCY-F1 2 . 6 , 1 1H  (RAD/SEC)  , 

9990  FORMAT ( 28H  ERROR  IN  READTP-ERROR  CODE-15) 

9991  FORMAT ( 28H  ERROR  IN  WRTETP-ERROR  CODE-15) 

END 
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SUBROUTINE  ADMIN2 


S I BFT C  ADMN2*  DECK 

SUBROUTINE  ADMIN, 2 

•  * 

•  ADMITTANCE  INTEGRALS* 

•  * 

*  USED  IN  FORMING  THE  * 

*  * 

*  JOINT  DEFLECTIONS  * 


*  * 

OPTION  2  BROAD  BAND  EXCITATION*  DAMPING  COEFFICIENTS  PROPORTIONAL 
TO  A  LINEAR  COMBINATION  OF  THE  MASS  INERTIA  AND  STIFFNESS 
COEFFICIENTS.  <  CROSS  MODAL  COUPLING  IS  INCLUDED  ) 


M  NUMBER  OF  FREQUENCIES.  MASS  AND  MODE  SHAPES 


THE  FREQUENCIES(FREQ) *  GENERALIZED  MASS(AMASS)  AND 
MODE  SHAPES ( PH  I )  COME  FROM  THE  EIGENVECTOR-EIGENVALUE 
ROUTINE  TV-105W. 


N 

NF 

G 

ALAM 

CMU 


NUMBER  OF  RETAINED  DEGREES  OF  FREEDOM 
NUMBER  OF  FREQUEUNC I ES  TO  CALCULATE  THE  CPSD 
STRUCTURAL  DAMPING 

A  DAMPING  PROPORTIONALITY  FACTOR  PROP.  TO  STIFFNESS 
A  DAMPING  PROPORTIONALITY  FACTOR  FOR  DAMPING  PROPORTIONAL 
TO  MASS. 


TAPE  OUTPUT  STORAGE  -  TAPE  16 
***** 

MATRIX  1  *M- 1*  PARAMETER  MATRIX! 3X1) 

*K  * 

*N  * 

***** 


MATRIX  2  0  PARAMETER  K  MATRIX  USED  FOR  OFF-DIAG  TEST 

OR  -1  t  M-l  BY  1  ) 


MATRIX  3  PHIIItJ)  I-l.M-1 

J=I *I+K 

DIMENSION  DE ( 25  *25 ) *  ED(25*25)*  DDEE(25*25)»  AMU(25)*  AMASS(25). 
1FREQ ( 25 ) *0M4 { 2 5 ) .X7I25) .FREQ4 < 25 ) *X 8 ( 25  )  .SCI  (25. 25)  . 

2SC2!  25.25 ) .SMAT (3) *B( 16) .PHI (100.25) .PHI M( 100 ) »NSTO ( 3 ) .KPARAM! 24 ) 
COMMON  /BLK1/  FREQ. AMASS 

COMMON /B LK2/M.N.G. ALAM. CMU. K.NF.NPL ATE. NBE AMS .NLOOP 
PI  =  3.14159265 
NTAP1  -  10 
NTAP12  «  12 
NTAP16-16 
REWIND  NTAP1 
REWIND  N TAP  12 
REWIND  NTAP16 
C 

DO  20  I-l.M 
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20  AMU ( I ) «CMU*ALAM*FREQ ( I )**2+G*FREQ( I ) 

C 

C  THE  FREQUENCIES  AND  MU  ARE  SCALED 

CALL  SCALE!  FREQ  •  M,  SCAL  ) 

C 

DO  25  I  -  1  »M 
25  AMU ( I  I  *  AMU! I ) /SCAL 
C 

MM-M-1 

C 

C**#FORM  PARAMETER  MATRIX  NSTO 
NSTO(l)  =  MM 
NSTO ( 2 )  =  X 
NSTO ( 3  )  -  N 
NAME  =  0 
NMAT  -  0 
NFILE  »  0 

CALL  WRTETP!NST0»1.NAME,3»1,B,NFILE»NMAT.NTAP16  »IRR) 

IF  (  IRR  .NE.  0  )  GO  TO  9999 

*«*FORM  PARAMETER  X  MATRIX  TO  TEST  FOR  NUMBER  OF  OFF-DIAGONAL  TERMS 
ARE  DESIRED 

MX  =  M-X 
DO  30  1=1. MX 
30  XPARAM!  I  )  =  0 
MX  »  MX+1 

IF  (  MX  .GT.  MM  )  GO  TO  50 
DO  40  I  >  MX, MM 
40  XPARAM ( I  )  «  -1 
50  NAME  =  0 
NMAT  =  0 
NFILE  =  0 

IF  (  X  .EQ.  1  )  GO  TO  55 
GO  TO  58 

55  XPARAM ( M )  ■  -1 
MM  =  M 

58  CONTINUE 

CALL  WRTETP! XPARAM, 1  .NAME, MM,  1  .6, NFILE, NMAT, NTAP 16. IRR) 

IF  (  IRR  .NE.  0  )  GO  TO  9999 
IF  (  X  .EQ.  1  )  MM  »  M-l 
NAME  =  0 
NMAT  = 1 
NFILE  =  2 

CALL  READTP ( PH  1  , 100 .NAME ,N »M ,B ,NF I LE .NMAT ,NTAP1 , I RR ) 

I F ( I RR  .NE.  0 ) GO  TO  9998 
NAME  =  0 
NMAT=0 
NFILE  =  0 

C  THE  MODE  SHAPES  PHI  ARE  STORED  ON  TAPE 

C#*** 

DO  90  I  1  =  1  , MM 
J1  =  II 
ML  =  II+X 

IF!  ML  .GT.  M  )  ML  =  M 
DO  90  J  =  Jl , ML 
DO  80  1=1, N 
80  PHIM( I )=PHI <1 ,J) 

CALL  WRTETP (PHI M,1 .NAME, N,1 ,B, NFILE. NMAT. NT AP16 ,  IRR) 

IF  (  IRR  .NE.  0  )  GO  TO  9999 
90  CONTINUE 
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THE  ADMITTANCE  INTEGRALS  FOR  OPTION  2  ARE  FORMED  AT  M 
NUMBER  OF  FREQUENCIES. 


*#*# 
•  ••• 


DO  100  I « 1  *M 
FREQ4I I ) =FREQ ( I )**4 
X 7  < I > = AMU ( I )**2-2.*FREQ< I )**2 
100  X  8  (  I  )  “SORT  I 4»*FREQ I  I  )  **2**AMU  (  I)**2)  *AMU(  I  ) 

C 

C 

DO  130  I = 1 »M 
DO  120  J»1»M 
I F ( I  .NE.  J ) GO  TO  110 
DEI  I  .J)  =  0. 

ED(JiI)  =  0. 

GO  TO  120 

110  X2-FREOI I )#*2-FREQ< J)**2 
X3  =  FREQ4I I )  -  FREQ4IJ) 

X4  =  AMU  I J ) *FR  EQ I I >  **2 
X5  *  AMU  I  I ) **2  AMU ( J ) **2 
X6  =  FREQIJ)** 4/FREQ  I  I )  **4 

BMAT  ■  (  X3*I-X4*X7< II-AMUI J)*FREQ4< I )  ) +  X4* I FREQ4 ( I ) *X7 I J > -FREQ4 
II J)*X7<  I  > )  )/<  FREQ41 I )*IX5-2.*X2)*(FREQ4I I)*X7I JI-FREQ4I J)*X7< I » ) 
2-FREQ4I I >*X3**2  ) 

AMAT  =  I  BMAT*FREQ4( I)*(  X5~2.*X2  )-X4  ) /X3 
CMAT  =  X4/FRE04 1  I )  -  X6*AMAT 

X«BMAT*ALOG(X6)/2.+(AMAT-BMAT*X7< I)/2.)*PI/X8( I ) 

X  *  X  +  I  CMAT  +  BMAT#X7( J)/2.  )*PI/X8(J) 

DE  ( I  *  J  )  -  X/l  2  *# AM ASS  I  I ) ♦ AM ASS  I J )  ) 

ED ( J  *  I )  -  DE I  I • J ) 

120  CONTINUE 
130  CONTINUE 
C 
C 

DO  3000  I  “  1  *M 
DO  3000  J  =  1 *M 

DDEEII.J)  ■  I  PI*(  AMUI I I+AMUI J) )  )/(  AMASS  I  I ) *AMASS ( J ) *  I  FREQ4IJ) 

1  +  AMU (I)##2  *FREQ ( J ) **2  ♦  AMU  I  I ) *AMU I J ) «FREQ ( J ) **2  +  FREQ4II)  ♦ 

2  AMU  I  I ) *AMU ( J ) *FREQ I  I ) #*2  +  AMUI J )**2*FREQ( I )**2  -  2.*FREQI 1 1**2* 

3  FREQ  I J ) #*2  )  ) 

3000  CONTINUE 

DO  4000  I«1»M 

DO  4000  J=1*M 

DEII.J)  =  DEI  I *J)/SCAL**3 

EDI J • I ) =DE( I  * J ) 

C  THE  SCALARS  ARE  RESCALED  BY  DIVIDING  BY  SCALE  FACTOR  CUBED. 

DDEEl I • J)  ■  DDEEI I »J ) /SCAL**3 
4000  CONTINUE 

WR I TE I  6  *  9000 ) 

WRITEI6.9001) 

DO  4100  I  >  l.M 
WRITEI6. 9002)1 

WR I TE I  6  *  9003 )  I  J.DEI I *J) .DDEEI I »J) » J*1 *M) 

WRI TE I  6 • 9004 ) 

4100  CONTINUE 
C 

MM*M«1 

C 

DO  5000  I-l.MM 
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Ml= 1+1 

DO  5000  J-MliM 

SClt I *J)«DE(I*J)-DE(J*I) 

SC2(I»J)—  SCKI.J) 

5000  CONTINUE 
C 

NAME  =  0 


NMAT  =  0 
NF I LE=0 
MM-M-1 
C 

C#*** 

C  SMAT(l)  ■  D  C I ) *D ( J )  +  E ( I ) *E ( J ) 

C  SMAT ( 2 )  *  D( I )*E ( J J  -  D(J)*E(I) 

C  SMAT  (  3  )  -  D  ( J  )  *E  (  I  )  -  D(I)*E(J) 

C 
C 

NAME  =  0 
NMAT  =  0 
NFILE  =  0 
C 

DO  6000  1=1 *MM 
M 1  =  I  +  1 


( INTEGRATE) 
(INTEGRATE) 
(INTEGRATE) 


6000 

C 


ML  =  I  +  K 

I F  <  ML  .GT.  M  )  ML  =  M 
DO  6000  J  *  Ml »ML 
SMAT { 1 ) =DDEE ( I *J) 

SMAT ( 2 ) =SC1 ( I ♦ J  ) 

SMAT ( 3 ) -SC2 ( I  *  J  ) 

CALL  WRTETPISMAT . 1 ♦ NAME # 3  *  1 »B # NF I LE » NMAT »NTAP 12 » I RR ) 

IF  (  IRR  »NE.  0  )  GO  TO  9999 

CONTINUE 


DO  6050  I  *  1 »M 
6050  FREQ ( I )  =  FREQ(I)*SCAL 
C 


END  FILE  NTAP12 
END  FILE  NTAP16 
RETURN 

9998  WR ITE ( 6 ♦ 9010 ) I RR 
CALL  EXIT 

9999  WRITE(6*9020)IRR 
CALL  EXIT 
RETURN 

9000  FORMAT (1H1*50X#21HADMITTANCE  INTEGRALS  //// ) 

9001  FORMAT ( 1H0# 10X i9HD( I ) *E ( J) *20X*22HD( I )*D( J )  +  E(I)*E(J) 

9002  FORMAT ( 1H0 * 3H  1*13) 

9003  FORMAT (7X# I  3 # 1 X . El A, 7  * 10X .E 14. 7 ) 

9004  FORMAT(IHO) 

9010  FORMAT  <  28H  ERROR  IN  READTP  ERROR  C0DE=I5) 

9020  FORMAT ( 28H  ERROR  IN  WRTETP  ERROR  CODE-15) 

END 


///> 
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SUBROUTINE  CQJD 


SIBFTC  CQJD*  DECK 

SUBROUTINE  CQJD 

C0MM0N/BLK2/M*N*G*ALAM*CMU*K 

DIMENSION  SMATI3) • B ( 16 ) *CFW ( 90  »  90 ) »QFW ( 90  *  90 ) 
NTAP12  =  12 
NTAP15  -  15 
NT AP 17  *  2 
NTAP18  =  14 
REWIND  NTAP12 
REWIND  NTAP15 
REWIND  NTAP17 
REWIND  NTAP18 
IQ  =  0 
MM  =  M-l 


♦••CALCULATE  THE  EXCITATIONS 
LOOP  11-1*2 


WHEN  1 1 - 1  THE  EXCITATIONS  FOR  REAL  PART 
ARE  STORED  ON  TAPE  15 
WHEN  I  I -2  THE  EXCITATIONS  FOR  IMAGINARY 
PART  ARE  STORED  ON  TAPE  15 


DO  500  II  *  1*2 

DO  200  I  =  1 *MM 
Ml  =  I  +  1 


ML  =  I+K 


I F (  ML  • GT •  M  )  ML  =M 
DO  200  J  =  Ml *ML 
NAME  =  0 
NMAT  =  0 
NFILE  =  0 

C***READ  IN  THE  ADMITTANCE  INTEGRAL  SCALARS 

CALL  READTP ( SMAT  *1 » NAME *NR  *NC  *B*NF I LEiNMAT  *NTAP12  * IRR ) 

I F (  IRR  *NE.  0  )  GO  TO  9998 

NAME  =  0 

NMAT  =  0 

NFILE  =  0 

C*»«READ  IN  THE  CO-POWER  SPECTRAL  DENSITY ( CFW ) 

CALL  READTP ( CFW  *90* NAME  *N»N  *B  *NFI LE  t NMAT  *NTAP17  » I RR ) 

I F (  IRR  *NE.  0  )  GO  TO  9998 

C»»»READ  IN  THE  QUAD-POWER  SPECTRAL  DENSITYtQFW) 

NAME  =  0 
NMAT  =  0 
NFILE  =  0 

CALL  READTP ( QFW  *  90  *  NAME  *N »N  » B • NF I LE  » NMAT *  NT APIS  * IRR ) 

I F  t  IRR  .NE.  0  )  GO  TO  9998 

C •••FORM  THE  EXCITATION  MATRIX  TO  BE  STORED  ON  TAPE  15 


I F (  IQ  *NE 

.  0  )  GO  TO  54 

DO  50  K 1 B 1 ♦ 

N 

DO  50  LI  = 

1  *  N 

50 

CFW ( K1 »  L 1 ) 
GO  TO  80 

=  CFW(K1*L1)*SMAT(1) 

54 

DO  55  K 1  » 

1  *N 

DO  55  LI  • 

1  *N 

55 

CFW  t  K1 *  LI ) 

«  CFW(K1*L1)*SMAT(3) 

80 

NAME  =  0 
NMAT  =  0 

♦  QFW(K1*L1)*SMAT  (2) 


+  QFW(K1*L1)*SMAT (1) 
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NFILE  *  0 

CALL  WRTETPICFW  » 90 • NAME  #N*N*B# NFILE  *NMAT  » NT API 5 , I RR 


I F (  IRR  .NE*  0  )  GO  TO 
200  CONTINUE 

C***REWIND  THE  TAPES  USED  IN 
REWIND  N TAP  1 2 
REWIND  NTAP17 
REWIND  NTAP18 
10  *  1 

500  CONTINUE 


9999 

CALCULATING  THE  IMAGINARY  PART 


END  FILE  NTAP15 
RETURN 


9998 

WRITE(6»9010) 

IRR 

CALL  EXIT 

9999 

WR I TE ( 6  »  9020 ) 

IRR 

CALL  EXIT 
RETURN 

9010 

FORMAT ( 28H 

ERROR  ! 

9020 

FORMAT (28H 

ERROR  i 

END 


N  READTP-ERROR 
N  WRTETP-ERROR 


CODE-15 ) 
CODE- I  5 ) 
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SUBROUTINE  SUMT 

SlBFTC  SUMT*  DECK 

SUBROUTINE  SUMT  (  NO#  INTAPE) 


SUBROUTINE  SUMT  -  A  MATRIX  WILL  BE  ADDED  TO  ITS 
TRANSPOSE  t 


COMMON  /BLK2/M# N #G # ALAM #CMU #K # NF iNPLATE #NBEAMS 
DIMENSION  SUM! 90*90 ) # AMAT ( 90 #90) #B( 16 ) • IPARAht2 ) 
NTAP8  •  8 
REWIND  NTAP8 
REWIND  INTAPE 


***CYCLE  ON  REAL  AND  IMAGINARY 
DO  600  III  «  1*2 
IF  (  III  »EQ.  1  >  GO  TO  50 
NMAT  =  0 

***SET  SIGN  »  “1  FOR  THE  IMAGINARY  PART 
SIGN  =  -1.0 
GO  TO  60 
50  NMAT  =  1 

***SET  SIGN  =  1  FOR  THE  REAL  PART 
SIGN  =  1.0 
60  CONTINUE 

DO  500  I  I  »  1 »NO 
NAME  =  0 
NFILE  ■  0 

CALL  READTP ( AMAT  » 90  #NAME • N • N • B #NF I LE #NMAT • INTAPE# 1 RR ) 
IF  (  IRR  .NE.  0  I  GO  TO  9985 
DO  100  I  “  1 #N 
DO  100  J  ■  1 #N 

100  SUM ( I > J )  ■  AMAT(I*J)  ♦  AMAT! J # I )*SIGN 
NAME  *  0 
NMAT  *  0 
NFILE  ■  0 

CALL  WRT ETP ( SUM • 90 # NAME #N#N#B# NFILE# NMAT #NTAP8#IRR) 

IF  (  IRR  »NE.  0  )  GO  TO  9986 
500  CONTINUE 
600  CONTINUE 


END  FILE  NTAP8 
REWIND  NTAP8 
REWIND  INTAPE 
NAME  =  0 
NMAT  =  0 
NFILE  ■  0 

C***A  PARAMETER  MATRIX  IPARAM  IS  FORMED 
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IPARAM(l)  m  NPLATE  +  2*NBEAMS 
I  PAR AM ( 2  )  *  NO 

CALL  WRTETP ( IP ARAM* 1 • NAME , 1 ,2 • B *NF I LE »NMAT » I  NT APE  » I  RR  ) 
IF  (  IRR  ,NE#  0  )  GO  TO  9986 
C 
C 
c 

C***CYCLE  ON  REAL  AND  IMAGINARY 
DO  900  III  -  1,2 
DO  800  I  I  ■  1 ,N0 
NAME  »  0 
NMAT  =  0 
NFILE  *  0 

CALL  READTP ( AMAT ,90, NAME, N#N,B» NFILE, NM AT, NTAP8,IRR) 

IF  (  IRR  ,NE,  0  )  GO  TO  9985 
NAME  =  0 
NMAT  =  0 
NFILE  =  0 

CALL  WRTETP (AM AT , 90 , NAME , N , N , B ,NF I LE »NMAT» INTAPE, IRR ) 

IF  (  IRR  ,NE.  0  )  GO  TO  9986 
800  CONTINUE 
900  CONTINUE 
C 
C 
C 

END  FILE  INTAPE 
REWIND  INTAPE 
RETURN 

9985  WR I TE ( 6 , 9990 )  IRR 
CALL  EXIT 

9986  WR I TE ( 6 , 999 1 )  IRR 
CALL  EXIT 
RETURN 

9990  FORMAT ( 28H  ERROR  IN  READTP-ERROR  C0DE»l5) 

9991  FORMAT ( 28H  ERROR  IN  WRTETP-ERROR  CODE-15) 

END 
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SUBROUTINE  SUM2 


SIBFTC  SUM2*  DECK 

SUBROUTINE  5UM2 (  I  TP  1  *  I TP2 »N0 . NCN  ) 


SUBROUTINE  SUM2  -  SUMS  THE  OPTION  3  LIKE 

MODE  EFFECTS  TO  UNLIKE  MODE  EFFECTS  TO  FORM 
TOTAL  OPTION  2  RESULTS. 


COMMON  /BLK2/M.N.G.ALAM.CMU.K.NF.NPLATE.NBEAMS 
DIMENSION  AMAT(90#90) #BMAT (90*90) *B( 16) #IPARAM(2) 

REWIND  ITP1 
REWIND  I TP2 
NAME  =  0 
NMAT  «  1 
NFILE  -  0 

CALL  READTP ( AMAT  *90 » NAME »N »N »B *NF I LE  *NMAT *  I  TP  1 . I RR ) 

IF  (  IRR  ,NE.  0  )  GO  TO  9985 

REWIND  ITP1 

NAME  =  0 

NMAT  »  1 

NFILE  -  0 

CALL  READTP ( BMAT. 90 .NAME .N.N.B , NFILE .NMAT. I TP2  . IRR) 

IF  (  IRR  .NE.  0  >  GO  TO  9985 
C 

DO  100  I  -  1 »N 
DO  100  J  -  1 *N 

100  AMAT I  I  .  J  )  -  AM AT ( I . J )  +  BMATII.J) 

C 

C***  ADD  OPTION  3  LIKE  MODES  TO  OPTION  2  UNLIKE  MODE  EFFECTS  TO 
C  GET  THE  TOTAL  JOINT  DEFLECTIONS 
IF  (  NCN  . EO.  1  )  GO  TO  200 
WR I TE I  6  » 9000 ) 

GO  TO  250 
200  WR I TE ( 6  *  9001 ) 

C 

250  DO  500  I  -  1»N 

WRITE (6 *9002) I*  I AMAT I I *J) .J-l.N) 

500  CONTINUE 
C 
C 

C***A  PARAMETER  MATRIX  NSTO  IS  FORMED 
I  PAR AM ( 1 )  -  NPLATE  ♦  2*NBEAMS 
I  PAR AM ( 2 )  ■  NO 
NAME  =  0 
NMAT  »  0 
NFILE  «  0 

CALL  WRTETPI IPARAM.l.NAME. 1.2 .B.NFILE. NMAT. ITPI.  IRR) 

IF  <  IRR  .NE.  0  )  GO  TO  9986 

CALL  WRTETP(AMAT.90.NAME.N»N.B.NFILE»NMAT.ITP1.IRR) 

IF  t  IRR  .NE.  0  )  GO  TO  9986 

CALL  READTP(AMAT.90.NAME.N»N.B.NFILE.NMAT.ITP2.IRR) 

IF  (  IRR  .NE.  0  )  GO  TO  9985 

CALL  WRTETPI AMAT. 90.NAME.N.N.B .NFILE. NMAT. ITPI  .IRR) 

IF  (  IRR  .NE.  0  )  60  TO  9986 
IF  (  NCN  .EQ.  1  )  GO  TO  800 
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SUBROUTINE  SECM3 


S  IBFTC  SECM3*  DECK 

SUBROUTINE  SECM3 


*  *  * 

•  ADMITTANCE  INTEGRALS* 

*  * 

*  USED  IN  FORMING  THE  * 

*  * 

*  DEFLECTION  second  * 

*  * 

•  MOMENTS*  * 


(  OPTION  3  ) 


OPTION  3  BROAD  BAND  EXCITATIONS*  DAMPING  COEFFICIENTS  PROPORTIONAL 
TO  A  LINEAR  COMBINATION  OF  THE  MASS  INERTIA  AND  STIFFNESS 
COEFFICIENTS.  (  NO  CROSS  MODAL  COUPLING  IS  INCLUDED  ) 


M  NUMBER  OF  FREQUENCIES#  MASS  AND  MODE  SHAPES 

N  NUMBER  OF  RETAINED  DEGREES  OF  FREEDOM 

G  STRUCTURAL  4AMPING 

ALAM  A  DAMPING  PROPORTIONALITY  FACTOR  PROP.  TO  STIFFNESS 

CMU  A  DAMPING  PROPORTIONALITY  FACTOR  FOR  DAMPING  PROPORTIONAL 

TO  MASS. 

D+MENSION  FREQ  ( 25J)  •  AMASSI25)#  AMU(25)#  DIAGJ25).  PHIM<25). 

1  PHI (100.25) #B( 16) #NST0( 1) 


COMMON  /BLK1/  FREQ#  AMASS 
COMMON  /BLK2/  M #N »G • ALAM# CMU 


NTAP1  -  10 
NTAP11  -  11 
REWIND  NTAP1 
REWIND  NTAP11 
NSTO ( 1 )  ■  M 
NAME  «  0 
NMAT  -  0 
NFILE  -  0 

CALL  WRTETP ( NSTO » 1 »NAME#1»1#B# NFILE  #NMAT  #NTAP11#IRR) 
IF  (  IRR  «NE.  0  »  GO  TO  9986 

DAMPING  FACTOR 


DO  10  I  -  1 #M 

AMU(I)  •  CMU  +  ALAM*FREQ(IJ»*2  ♦  G*FREQ ( I ) 


DIAGONAL  SCALARS  ARE  COMPUTED 

DO  20  I  «  1 #M 
PI  -  3.14159265 
20  DIAG(I)  -  PI/<  2.0*AMU<I)*AMASS(I)*»2  ) 

NAME  -  0 
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WR I TE ( 6  *  9003 ) 

GO  TO  900 
800  WR I TE ( 6  #  9004 ) 

C 

900  DO  950  I  ■  1 *N 

WRITE (6* 9002) I  * < AMAT ( I #J) »J-1.N) 
950  CONTINUE 


9985 

9986 

9000 

9001 

9002 

9003 

9006 

9990 

9991 


END  FILE  ITP1 
RETURN 

WR I TE ( 6  *  9990 )  IRR 
CALL  EXIT 
WR I TE ( 6  #  9991 )  IRR 
CALL  EXIT 
RETURN 

FORMAT ( 1H1*30X*55HDEFLECTI0N  SECOND  SPECTRAL  MOMENT  MATRIX 
1PART  )  ///> 

FORMAT(1H1*30X*63HDEFLECTION  COVARIANCE  MATRIX  (  REAL  PART 
FORMAT <1H0» I  5 • 1P7E16 . 6/ < E22 .6  * 6E 16. 6 )  ) 

FORMAT (1H1.30X.59HDEFLECT ION  SECOND  SPECTRAL  MOMENT  MATRIX 
INARY  PART  )  // ) 

FORMAT ( 1H1 »  30X .48HDEFLECT ION  COVARIANCE  MATRIX  (  IMAGINARY 
1  //) 

FORMAT (28H  ERROR  IN  READTP-ERROR  CODE-15) 

FORMAT (28H  ERROR  IN  WRTETP-ERROR  CODE-15) 

END 


(  REAL 
)  ///) 
(  IMAGI 
PART  ) 
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NMAT  ■  0 
NFILE  -  0 

CALL  WRTETP(DIAG*1 *NAHE  *1*M.B» NFILE #NMAT  .NTAPll » I  RR ) 
NAME  -  0 
NMAT  -  1 
NFILE  -  2 


***  THE  MODE  SHAPES  ARE  READ  IN. 

CALL  READTPIPHI » 1 00  * NAME  » N • M ♦ B *NFILE»NMAT*NTAP1*IRR) 

IF  (  IRR  .NE.  0  >  GO  TO  9985 
NAME  =  0 
NMAT  =  0 
NFILE  -0 
C 

DO  50  J=1»M 
DO  40  I-1*N 

40  PH  I M ( I )  =  PHI ( I #J) 

CALL  WRTETP (PHIM»1 .NAME *N # 1 «Bt NFILE *NMAT *NTAPU .IRR) 

IF  (  IRR  .NE*  0  )  GO  TO  9986 
50  CONTINUE 
C 

END  FILE  NT  API 1 
RETURN 

9985  WR I T E ( 6 * 9990 )  IRR 
CALL  EXIT 

9986  WR I TE ( 6 • 9991 )  IRR 
CALL  EXIT 
RETURN 

9990  FORMAT  1 28H  ERROR  IN  READTP-ERROR  CODE-15) 

9991  FORMAT ( 28H  ERROR  IN  WRTETP-ERROR  CODE-15) 

END 
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SUBROUTINE  SECM2 


OMITTANCE 


USED 


I  N 


DEFLECTION 


•MOMENTS. 


OPTION  2 


SIBFTC  SECM2*  DECK 

SUBROUTINE  SECM2 

C 

C  * 

C  *  A 

C  * 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 

C  M 

c 

c 
c 
c 
c 
c 

C  N 
C  NF 
C  6 
C  ALAM 
C  CMU 
C 
C 

C***TAPE  OUTPUT  STORAGE  -  TAPE  16 


INTEGRAL 


S  * 


FORMING 


THE 


SECOND 


# 


BROAD  BAND  EXCITATION,  DAMPING  COEFFICIENTS  PROPORTIONAL 
TO  A  LINEAR  COMBINATION  OF  THE  MASS  INERTIA  AND  STIFFNESS 
COEFFICIENTS.  (  CROSS  MODAL  COUPLING  IS  INCLUDED  ) 


NUMBER  OF  FREQUENCIES,  MASS  AND  MODE  SHAPES 


THE  FREQUENCIES(FREQ) ,  GENERALIZED  MASS(AMASS)  AND 
MODE  SHAPES ( PH  I )  COME  FROM  THE  EIGENVECTOR-EIGENVALUE 
ROUTINE  TV-105W. 

NUMBER  OF  RETAINED  DEGREES  OF  FREEDOM 
NUMBER  OF  FREQUEUNCIES  TO  CALCULATE  THE  CPSD 
STRUCTURAL  DAMPING 

A  DAMPING  PROPORTIONALITY  FACTOR  PROP.  TO  STIFFNESS 
A  DAMPING  PROPORTIONALITY  FACTOR  FOR  DAMPING  PROPORTIONAL 
TO  MASS* 


C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


MATRIX  1 


MATRIX  2 


MATRIX  3 


*M— 1*  PARAMETER  MATRIX! 3X1) 

*K  * 

*N  * 

*•*•• 

o  parameter  k  matrix  used  for  off-diag  test 
OR  -1  (  M-l  BY  1  ) 


PHI ( I , J ) 


I-l.M-l 

J“I,I+K 


DIMENSION  DE ( 25 ,25 ) ,  ED(25,25),  DDEE(25#25>*  AMUI25),  AMASS<25)» 
1FREQ ( 25 ) »0M4( 23 ) »X7 ( 25 ) ,FREQ4 ( 25) *X 8(25) • SC 1(25, 25), 

2SC2< 25,25) *SMAT<3) *B< 16 ) ,PHI ( 100 ,25 ) *PH IM ( 100 ) ,NSTO ( 3 ) ,KPARAM( 24 ) 
COMMON  /BLK1/  FREQ, AMASS 


U  O  UUU  <J  'j 


COMMON  /BLX2/  M *N « G * ALAM *CMU •  K. 

PI  =  3.14159265 
NTAP1  =  10 
NTAP12  =  12 
NTAP16-16 
REWIND  NTAP1 
REWIND  NTAP12 
REWIND  NTAP16 
C 

DO  20  I  *  1  *M 

20  AMU< I ) *CMU+ALAM*FREQ ( I ) #*2*G»FREQ <  I ) 


25 


THE  FREQUENCIES  AND  MU  ARE  SCALED 
CALL  SCALE!  FREQ*  M*  SCAL  ) 


DO  25  I  =  1  *M 

AMU  < I )  =  AMU( I )/SCAL 

MM*M-1 

NSTO(l)  «  MM 
NSTO ( 2 )  *  X 
NSTO ( 3 )  »  N 
NAME  =  0 
NMAT  =  0 
NFILE  =  0 

CALL  WRTETP(NSTO*l*NAME*3*l*B* 
IF  t  IRK  .NE.  0  )  GO  TO  9999 
RM  PARAMETER  X  MATRIX  TO  TEST 
ARE  DESIRED 


NFILE*NMAT»NTAP16*IRR> 

FOR  NUMBER  OF  OFF-DIAGONAl  TERMS 


MX  =  M-X 
DO  30  1=1 *MX 
30  XPARAM(I)  =  0 
MX  =  MX+1 

IF  (  MX  .GT.  MM  )  GO  TO  50 
DO  40  I  =  MX  *MM 
40  XPARAM(I)  ■  “I 
50  NAME  =  0 
NMAT  =  0 
NFILE  «  0 

IF  (  X  .EQ.  1  )  GO  TO  55 
GO  TO  58 

35  XPARAM(M)  -  -1 
MM  =  M 

CALL  WRTETP ( XPARAM* 1 *NAME  *MM*1 *B  *NF I LE * NMAT  »NTAP16*IRR) 

IF  (  IRR  »NE.  0  )  GO  TO  9999 

IF  (  X  .EQ.  1  )  MM  ■  M-l 

NAME  =  0 

NMAT=1 

NFILE  =  2 

CALL  READTP ( PHI  *  100 .NAME *N * M * B *NF ILE tNMAT *NTAP1 * IRR ) 

I F  < IRR  .NE.  0)60  TO  9998 
NAME  =  0 
NMAT=0 
NFILE  =0 

THE  MODE  SHAPES  PHI  ARE  STORED  ON  TAPE 

*••• 

DO  90  11*1 *MM 
J1  =  II 
ML  -  II+X 

I F (  ML  .GT.  M  )  ML  -  M 
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DO  90  J  -  J1 *ML 
DO  80  ]>1*N 
80  PHIM(  I  |i  «PHI  (  I  *  J  ) 

CALL  WRTETP<PHIM.1»NAME*N.1»B.NFILE.NMAT.NTAP16»IRR) 

IF  I  IRR  .NE.  0  )  GO  TO  9999 
90  CONTINUE 
C**»* 

c**** 

C  THE  ADMITTANCE  INTEGRALS  FOR  OPTION  2  ARE  FORMEO  AT  M 

C  NUMBER  OF  FREQUENCIEV. 

C***# 

DO  100  I-l.M 
FREQ41 I ) =FREQ ( I ) **4 
X  7 ( I ) =  AMUI I )**2-2.*FREQ( I )**2 
100  xeill =  SQRT I 4»*FREQ 1 1 ) «*2“AMU ( I ) **2 I *AMU ( I ) 

C 

c 

DO  130  I  *1  *M 
DO  120  J*1»M 
IFII  .NE.  J ) GO  TO  110 
DEC  I • J )  =  0. 

ED ( J » I  )  =  0. 

GO  TO  120 

110  X2»FREOm**2-FREO(  J)**2 
X3  »  FREQ4I I )  -  FREQ4IJ) 

X4  -  AMUI J)*FREQ(I)*»4 
X5  =  AMU(t)**2  -  AMU ( J ) **2 
X6  »  FREQ! J)**4/FREQ< I )*»4 

BMAT  -  (  AMUI J)*FREQ4< I >*FREQ< I >**2*X3  +  X4*l  FREQ4(I)*X7( J)-FREQ 

1  4 ( J ) *X7 ( I )  )  ) ✓ C  FREQ4I I )*(  X5-2.0*X2  »*<  FREQ4I I )*X7I J>- 

2  FREQ4 ( J ) *X7 ( I )  )  -  FREQ4I I)*X3»*2  ) 

AMAT  »  (  BMAT*FREQ4I I )*<  X5-2.*X2  )-X4  ) /X 3 
CMAT  =  -AMAT*X6 

X  -  BMAT  *ALOG  (  X6  )  /  2  •  0  ♦  (  AMAT-BMAT*X7< I ) /2 .0  )*PI/X8(I) 

X  »  X  I  CMAT  BMAT*X7U)/2.  )*PI/X6IJ) 

DE(IiJ)  -  X/(  2.*AMASS( I )»AMASSIJ)  ) 

EDI J  *  I  )  °  DEII • J ) 

120  CONTINUE 
130  CONTINUE 
C 
C 

DO  3000  I  *1 #M 

DO  3000  J  ■  1 *M 

1 F <  I  *EQ.  J  )  GO  TO  3000 

3000  DDEE ( I  * J )  ■  (  P I * <  AMUI I )*FREQIJ)**2+  AMU( J)*FREQII)**2  )  )/» 

1  AMASS! I )*AMASSIJ)*<  FREQ4IJ)  +  AMUI I ) »*2*FREQ I J ) **2  + 

2  AMUI  I)*AMUI J)*FREQ|J)**2  +  FREQ4II)  ♦  AMU(  I  )«AMU<  J  J 

3  *FREQ( I )**2  ♦  AMU( J)**2*FRE0( I )**2  -  2 .0*FREQ (I) »*2* 

4  FREQ ( J ) **2  »  ) 

DO  4000  I  *  1 iM 

DO  4000  J«1*M 

DEI  I ♦ J )  -  DEI  I »J)/SCAL 

ED  I J  *  I ) =DE ( I # J  ) 

IF!  I  .EQ.  J  )  GO  TO  4000 

C  THE  SCALARS  ARE  RESCALED  BY  DIVIDING  BY  SCALE  FACTOR  CUBED. 

DDEE I  I • J )  -  DDEEI I»J)/SCAL 
4000  CONTINUE 
MM-M-1 

DO  5000  1*1 .MM 
Ml-I+1 
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DO  5000  J-Ml *M 
SC1(I*J)*DE(I*J ) -DE (  J  #  I  ) 
SC2  (  I  *J)  —  SC1(  I  *J) 

5000  CONTINUE 
NAME  -  0 
NMAT-0 
NFILE-0 
MM-M-1 


SMAT(l) 
SMAT ( 2 ) 
SMAT ( 3 ) 


D< I)*D( J> 
D ( I )*E< J) 
D( J  )*E (  I  ) 


+  E (I ) *E ( J ) 

-  D ( J ) *E (  I  ) 

-  D ( I ) *E ( J ) 


( INTEGRATE) 
( INTEGRATE) 
( INTEGRATE) 


NAME  =  0 
NMAT  *  0 
NFILE  «  0 
DO  6000  I  *  1  *  MM 
Ml-I+1 
ML  -  I  +  K 

I F (  ML  .GT.  M  )  ML  -  M 
DO  6000  J  -  Ml i ML 
SMAT ( 1 ) =DDEE ( I  * J I 
SMAT ( 2 ) “SCI ( I  * J ) 

SMAT ( 3)=SC2( I  *  J ) 

CALL  WRTETP(SMAT*1.NAME»3.1*8*NFILE*NMAT*NTAP12»IRR) 
IF  (  IRR  «NE»  0  )  GO  TO  9999 
6000  CONTINUE 
54  CONTINUE 
C 

DO  6050  1  ■  1 *M 
6050  FREQ ( I  )  -  FREQ(I)»SCAL 
END  FILE  NTAP12 
END  FILE  NTAP16 
RETURN 

9998  WRITE(6*9010) IRR 
CALL  EXIT 

9999  WRITE! 6*9020) IRR 
CALL  EXIT 
RETURN 

9010  FORMAT <28H  ERROR  IN  READTP  ERROR  CODE-15) 

9020  FORMAT ( 28H  ERROR  IN  WRTETP  ERROR  CODE-15) 

END 
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SUBROUTINE  ADMIT3 


SIBFTC  ADMT3*  DECK 

SUBROUTINE  ADMIT3 


#  * 

•  ADMITTANCE  SCALARS* 

*  * 

*  USED  IN  CALCULATING  THE  DEFLECTION  * 

*  RESPONSE  CROSS  POWER  SPECTRAL  DENSITY  * 

*  (  CPSD  )  * 

*  * 

*  OPTION  3  * 


OPTION  3  BROAD  BAND  EXCITATION.  DAMPING  COEFFICIENTS 

PROPORTIONAL  TO  A  LINEAR  COMBINATION  OF  THE 
MASS  INERTIA  AND  STIFFNESS  COEFFICIENTS. 

I  NO  CROSS  MODAL  COUPLING  ) 

D(I)  REAL  FACTOR  IN  THE  DIAGONAL  ADMITTANCE  SCALAR 


El  I) 


IMAGINARY  FACTOR  IN  THE  DIAGONAL  ADMITTANCE  SCALAR 


N 

M 

NF 

G 

ALAM 

CMU 


NUMBER  OF  RETAINED  DEGREES  OF  FREEDOM 

NUMBER  OF  FREQUENC I ES < FREQ ) .GENERAL  I  ZED  MASS(AMASS) 

AND  MODE  SHAPES ( PHI ) 

NUMBER  OF  FKEQUEUNCIES  TO  CALCULATE  THE  CPSD 
STRUCTURAL  DAMPING 
A  DAMPING  PROPORTIONALITY  FACTOR 
A  DAMPING  PROPORTIONALITY  FACTOR 


DIMENSION  FREQ  t  25  )  .  AMASS ( 25 ) .  OMEG(100)»  PHI ( 100 . 25 ) .PH  I  Ml  100 ) « 
1  AMU  <  25 )  .  0(25) •  E<25)»  DD<25>.  B(16).  NSTO<3) 

COMMON  /BLK1/  FREQ . AMASS .OMEG 
COMMON  /BLK2/  M .N .G . ALAM * CMU *K .NF 
COMMON /BLK 3/  FLG 1 . FLG2 * FLG3 . FLG4 
INTEGER  FLG1.FLG2.FLG3.FLG4 
NTAP1  *  10 
NTAP2  “  2 
NTAP11  *  11 
REWIND  NTAP1 
REWIND  NTAP2 
REWIND  NTAP11 
NAME  »  0 
NMAT  =  1 
NFILE  ■  2 
C 

C***  THE  MODE  SHAPES  ARE  READ  IN. 

C 

CALL  READTP ( PHI , 100 .NAME .N .M *B .NF I LE .NMAT .NTAP1  . 1 RR ) 

IF  (  IRR  .NE.  0  I  GO  TO  9985 

NSTO(l)  «  M 

NST012)  =  M 

NSTO ( 3 )  *  NF 

NAME  =  0 

NMAT  =  0 

NFILE  “  0 
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CALL  WRTETP (  NSTO*  1.  NAME  *  3 • 1 . B .NF I LE . NMAT .NT AP2 » I RR ) 
IF  (  IRR  «N£  •  0  )  60  TO  9986 
NAME  =  0 
NMAT  =  0 
NFILE  =  0 
DO  20  J  '  liM 
DO  10  I  *  1  •  N 
10  PHIMt I )  »  PHI ( I *JI 

CALL  WRTETP ( PHI M . 1  *  NAME *N . 1  * B * NF I LE . NMAT .NTAP11 »IRR) 

IF  (  IRR  .NE.  0  )  GO  TO  9986 
20  CONTINUE 


***# 

#*## 

WRITE(6*9000) 

NAME  =  0 
NMAT  =  0 
NFILE  -  0 

THE  ADMITTANCE  SCALARS  FOR  OPTION  3  ARE  FORMED  AT  NF 
NUMBER  OF  FREQUENCIES. 

#*** 


***« 


DO  40  I  I  =  1 1 NF 
WRITE(6.9001)  OMEG (II) 

DO  25  J=1*M 

AMU(J)  =  CMU  +  ALAM*FREQl J)**2  +  G*FREQ ( U ) **2/OMEG d  I  ) 

DO  30  1=1 »M 

DEN  =  AMASS ( I ) * (  (  FREQ ( I ) **2“OMEG (  I  I  ) **2  >**2  +  OMEG (  I  I ) **2* ( 
1  AMU ( I )  1**2  ) 

0(1)  =  (  FREQ< I )**2-0MEG< I  I >**2  ) /DEN 
E(I)  =  OMEG< I  I ) *AMU< I ) /DEN 
30  DD< I ) =D< I ) **2+E ( I )**2 

W  R I T  E ( 6  *  9002 )  (  I#  DD(I)»I-1*M  ) 

CALL  WRTETP ( DD ♦ 1 .NAME  » 1 *M »B » NF I LE »NM AT .NT AP2 » I RR I 
IF  (  IRR  .NE.  0  )  GO  TO  9986 
CONTINUE 


END  FILE  NTAP2 
END  FILE  NTAP11 
RETURN 

9985  WRITEI6.9990)  IRR 
CALL  EXIT 

9986  WR I T E ( 6 . 9991 )  IRR 
CALL  EXIT 
RETURN 

9000  FORMAT l 1H1 . 40X . 32HADMI TTANCE  SCALARS  (  D**2+E**2  )////  ) 

9001  FORMAT ( 1H0. 10HFREQUENCY-E14.7 »9H (RAD/SEC )  ) 

9002  FORMAT ( IX. I 5.5X.E14.7  ) 

9990  FORMAT ( 28H  ERROR  IN  READTP-ERROR  CODE=I5) 

9991  FORMAT ( 28H  ERROR  IN  WRTETP-ERROR  CODE«I5) 

END 
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SUBROUTINE  ADMIT2 


SlBFTC  ADMT2*  DECK 

SUBROUTINE  ADMIT2 

*  * 

•  ADMITTANCE  SCALARS  * 

*  * 
*  USED  IN  CALCULATING  THE  DEFLECTION  • 

*  RESPONSE  CROSS  POWER  SPECTRAL  DENSITY  * 

*  OR  CPSD.  * 

•  * 


OPTION 


BROAD  BAND  EXCITATION*  DAMPING  COEFFI 
TO  A  LINEAR  COMBINATION  OF  THE  MASS  I 
COEFFICIENTS*  (  CROSS  MODAL  COUPLING 


CIENTS  PROPORTIONAL 
NERTIA  AND  STIFFNESS 
IS  INCLUDED  ) 


D ( I )  ADMITTANCE  SCALAR  -  DIAGONAL  MATRIX*  REAL  FACTOR  IN 

ADMITTANCE  MATRIX. 

E (  I »  ADMITTANCE  SCALAR  -  DIAGONAL  MATRIX*  IMAGINARY  FACTOR 

IN  ADMITTANCE  MATRIX. 


THE  FREQUENC I ES ( FREQ ) *  GENERALIZED  MASS(AMASS)  AND 
MODE  SHAPES (PHI)  COME  FROM  THE  EIGENVECTOR-EIGENVALUE 
ROUTINE  TV-105W. 

N  NUMBER  OF  RETAINED  DEGREES  OF  FREEDOM 

NF  NUMBER  OF  FREQUEUNC I ES  TO  CALCULATE  THE  CPSD 

G  STRUCTURAL  DAMPING 

ALAM  A  DAMPING  PROPORTIONALITY  FACTOR 

CMU  A  DAMPING  PROPORTIONALITY  FACTOR 


( 1 00 ) • B ( 16 
(25*25) *ED 
) *  PHI M ( 100 


NTAP1  '  10 
NTAP2  =  2 
NT APIS  =  16 
REWIND  NTAP1 
REWIND  NTAP2 
REWIND  NTAP16 
MM  =  M-l 


DIMENSION  D(25) • E ( 2 5 )  * DD ( 25 ) *OMEG 

1  • DDEE (25*25) *SMAT ( 3 ) *DE 

2  25) *FREQ( 25 ) .PHI ( 100*25 
COMMON  / 3LK1 /  FREQ  *  AMASS *OMEG 
COMMON  /6LK2/  M * N *G • ALAM * CMU *K *NF 


) *SC1 (25*25) »  SC2 (25*25) 
(25*25) ♦ AMU (25) .AMASS ( 

) *NSTO ( 4 ) tKPARAM ( 24 ) 


C 

C***FORM  PARAMETER  MATRIX  NSTO 
NSTO ( 1 )  =  MM 
NSTO ( 2 )  =  K 
NST013)  =  N 
NSTO ( 4 )  =  NF 
NAME  =  0 
NMAT  =  0 


Annnnnnn  non 


NFILE  =  0 

CALL  WRTETP < NSTO. 1. NAME, 4. l.B, NFILE. NMAT. NTAP 16. IRR) 

I F (  IRR  .NE.  0  )  GO  TO  9999 

C***FORM  parameter  k  matrix  to  test  for  number  of  off-diagonal  terms 

MK  =  M-K 
DO  10  I  =  1 »MK 
10  KPARAM (I)  *  0 
MK  =  MK  +  1  ' 

IF  (  MK  .GT.  MM  )  GO  TO  30 
DO  20  2  =  MIC  *  MM 
20  KPARAM ( I )  -  -1 
30  NAME  =  0 
NKAT  =  0 
NFILE  *  0 

IF  (  K  .EQ.  1  )  GO  TO  35 
GO  TO  38 

35  KPARAM(M)  =  -1 

MM  =  M 

36  CONTINUE 

CALL  WRT ETP ( KPARAM* 1 .NAME *MM*1.B*NF I LE*NMAT  *N TAP  16. IRR) 

I F  t  IRR  .Nt.  0  )  GO  TO  9999 
IF  (  K  .EQ.  1  I  MM  =  M-l 
NAME  =  0 
NMAT  =  1 

NFILE  =  2 

THE  MODE  SHAPES  ARE  READ 

CALL  READTP ( PHI . 100 .NAME. N.M.B. NFILE. NMAT . NT API . IRR ) 

I F (  IRR  .NE.  0  )  GO  TO  9998 

NAME  =  0 

NMAT  =  0 

NFILE  =  0 

DO  70  II  =  1 .MM 

J1  =  II 

ML  =  II+K 

I F (  ML  .GT.  M  )  ML  =  M 
DO  70  J  =  Jl.ML 
DO  60  I  ■  1 » N 
60  PHIMf I )  =  PHI (  I  .J  ) 

CALL  WRTETP (  PH  I M . 1 .NAME . N . 1 *B .NF I LE .NMAT .NT AP 16 • I RR  ) 

IF  (  IRR  .NE.  0  )  GO  TO  9999 
70  CONTINUE 

END  FILE  NTAP16 


THE  ADMITTANCE  SCALARS  FOR  OPTION  2  ARE  FORMED 
SMAT(l)  *  D ( I ) *D  <  J )  +  E ( I ) *E ( J ) 

SMAT ( 2 )  »  Dlll*E(J|  -  D ( J ) *E ( I ) 

SMAT ( 3 )  =  D ( J ) *C ( I )  -  D ( I ) *E  <  J ) 


END  FILE  NTAP2 
C 

DO  1000  11=1. NF 
DO  100  J  =  1 » M 

100  AMU( J) «CMU+ALAM*FREQ( J)**2+G*FREU( J )**2/OME6( I  I ) 

C 

DO  200  1  =  1. M 

DEN  =  AMASS ( I ) *  t  (  FREQ ( I )**2“OMEG( I  I )**2  >**2  +  OMEG ( I  I ) **2* ( AMU 
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i  m  )**2  ) 

D(I)  *  (  FREQ t I ) »*2“0MEG I  1 1 ) ##2  ) /DEN 
200  E ( I ) =OMEG (II)*AMU(I)/DEN 
C 

DO  300  I  =  1  *  M 
DO  300  J  =  1  # M 
DEI  I  * J ) =D( I ) *E I J ) 

ED  I J . I ) =DE ( I  .J) 

300  DDEEI I » J ) =D ( I ) *D I J ) +E I I )*E( J ) 

C 

WRITE  I  6  *  9000 ) 

WR I TE I  6 • 9001 ) 

C 

DO  4100  I  =  1  *  M 
WR I T  E I  6  * 9002 ) I 

WR I TE I  6  *  9003 )  (  J*DE( I  .  J  )  iDDEE I  I  * J ) * J" 1 »M ) 

WR I TE I  6  *  9004 ) 

4100  CONTINUE 
C 

DO  400  1*1. MM 
Ml* I +1 

DO  400  J=M1»M 

SCK  I  .J)  *  DEI  I  .JJ-DEI  J.I  ) 

400  SC2I  I  .J)«-SC1(  I  *  J  ) 

NAME  *  0 
NMAT  =  0 
NFILE  »  0 
DO  500  I  *  1 »MM 
Ml-I+1 
ML  =  I  +  K 

IF!  ML  «GT.  M  )  ML  -  M 
DO  500  J  =  Ml .ML 
SMATI 1 )  *  DDEE I  I »J) 

SMATI2)  =  SC11I.J) 

SMATI3)  *  SC2I I »J) 

CALL  WRTETPISMAT .1. NAME. 3*1. B* NFILE .NMAT .NTAP2.IRR) 
IF! IRR  .NE.  0 ) GO  TO  9999 
500  CONTINUE 

END  FILE  NTAP2 
1000  CONTINUE 


END  FILE  2 
RETURN 

9998  WR ITE I  6 . 9010 ) I RR 
CALL  EXIT 

9999  WRITEI6. 9020) IRR 
CALL  EXIT 
RETURN 

9000  F0RMATI1H1.50X.21HADMITTANCE  SCALARS  ////) 

9001  FORMAT tltfO. 10X.9HDI I )  *E  I J) .20X.22HDI I )*D< J)  +  EII)*E<J) 

9002  FORMAT  1 1H0 . 3H  1  =  13) 

9003  FORMAT (7X.I3.1X.E14.7.10X.E14.7) 

9004  FORMAT(IHO) 

9010  FORMAT!  28H  ERROR  IN  READTP-ERROR  C0DE=I5  ) 

9020  FORMAT  1 28H  ERROR  IN  WRTETP  ERROR  C0DE*I5) 

END 


///) 
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SUBROUTINE  CQCPSD 


SIBFTC  CQCPS*  DECK 

SUBROUTINE  CQCPSD 

COMMON /BLK2/M*N*G*ALAM*CMU*K«NF 

DIMENSION  SMAT ( 3 ) *CFW <  90  * 90 ) »QFW (90*90)*B(16) 

♦•♦ROUTINE  THAT  STORES  THE  EXCITATIONS  FOR  THE  CROSS  POWER  SPECTRAL 
DENSITY  ON  TAPE 

FSF  FORWARD  SPACE  FILES 

CALLING  SEQUENCE  CALL  F SF ( NF I LE *  NT AP 1 8  * LERROR ) 

WHE  R  E 

NF  I LE-NO  OF  FILES  TO  FORWARD  SPACE 
NT API 8= LOGICAL  TAPE  UNIT 
LERROR-  0  SUCCESS 

NON-ZERO  NO  Of  UNSPACED  FILES 

BSF  BACKSPACE  FILES  SAME  CALLING  SEQUENCE  AS  FSF 


NTAP2  ' 

NTAP15' 

NTAP18 

REWIND 

REWIND 

REWIND 

IQ  =  0 


'  2 

'  15 
=  14 
NTAP2 
NTAP15 
NT  AP 1 8 


MM  =  M— 1 
DO  600  IJ  =  1*2 
IF  (  IJ  *EQ.  2  )  IQ  =  1 
C * **LOOP  NO  OF  FREQUENCIES 
DO  500  II  -  1 • NF 
NF I LE  =  1 

CALL  FSF (  NFILE,NTAP2*LERROR  > 

DO  200  I  =  1 *MM 
Ml  =  I  +  1 
ML  =  I+K 

I F {  ML  .GT.  M  )  ML  *  M 
DO  200  J  =•  Ml  *ML 
NAME  =  0 
NMAT  =  0 
NFILE  =  0 

C***READ  IN  THE  ADMITTANCE  SCALARS 

CALL  RE AD TP ( SMAT ♦ 1  *  NAME  *NR  * NC  * B*NF I LEtNMAT *NTAP2 ♦ I RR ) 
I F (  IRR  .NE.  0  I  GO  TO  9998 
C»**READ  THE  CO-POWER  SPECTRAL  DENSITY(CFW) 

NAME  =  0 
NMAT  =  0 
NFILE  =  1 

CALL  READTP (CFW*90*NAME*N*N*B*NF I LE  *NMAT  *NTAP18*IRR) 

I F (  IRR  #NE.  0  )  GO  TO  9998 
^•♦•READ  IN  THE  QUAD-POWER  SPECORAL  DENSITY(QFW) 

NAME  =  0 
NMAT  =  0 
NFILE  =  0 

CALL  READTP (QFW  *  90 • N AME  *N  *N  * B * NF I LE  * NMAT  *  NT API 8 • IRR ) 

I F (  IRR  .NE.  0  )  GO  TO  9998 
IF  (  IQ  .NE.  0  >  GO  TO  54 
C 
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♦♦♦FORM  THE  EXCITATION  MATRIX  TO  BE  STORED  ON  TAPE  15 
DO  50  XI  *  1»N 
DO  50  LI  -  1*N 

50  CFW ( XI #  L 1 )  =  CFW(X1»L1)*SMAT(1)  +  QFW < X 1 .LI ) *SMAT ( 2 ) 


GO  TO  80 
54  CONTINUE 

♦♦♦READ  THE  QUAD-POWER  SPECTRAL  DENSITY { QFW ) 

DO  60  XI  «  l.N 
DO  60  LI  =  1 *N 

60  CFW( XI »L1 )  -  CFW(Kl.Ll) *SMAT ( 3 )  +  QFW( XI »L1 ) *SMAT ( 1 > 
80  CONTINUE 
NAME  =  0 
NMAT  =  0 
NFILE  -  0 

CALL  WRTETP(CFW*90iNAMEiN*N»B* NFILE  *NMAT  .NT API 5  *  I R  R ) 
I F (  IRR  .NE.  0  )  GO  TO  9999 
NFILE  =  1 

CALL  BSF  CNFILE.NTAP18.LERROR) 

I F  <  LERROR  .NE.  0  )  GO  TO  9997 
200  CONTINUE 


IF  (  I  .EQ.  MM  )  GO  TO  500 
NFILE  -  1 

CALL  FSFINFILE.NTAP18.LERROR  ) 
CONTINUE 


REWIND  NTAP2 
REWIND  N TAP  18 
CONTINUE 
END  FILE  NT  API  5 


RETURN 


9997 

9998 

9999 

9005 

9010 

9020 


WR I TE ( 6  *  9005 )  LERROR 

CALL  EXIT 

WRITEI6.9010)  IRR 

CALL  EXIT 

WR  I  TE ( 6  •  9020 )  IRR 

CALL  EXIT 

RETURN 

FORMAT ( 67H  ERROR  IN 
ID  FILES  IS  15  ) 
FORMAT (28H  ERROR  IN 
FORMAT ( 28H  ERROR  IN 
END 


BSF  ROUTINE! 

READTP-ERROR 

WRTETP-ERROR 


BACXSPACE 

CODE-15) 

CODE-15) 


F I LES ) -NUMBER  OF  UNSPACE 
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SUBROUTINE  SUM3 


SIBFTC  SUM3*  DECK 

SUBROUTINE  SUM3 (  I  TP  1 , 1 TP2 *  I  TP 3 ) 


CROSS  MODAL  EFFECT  OF  CROSS-PSD  MATRICES  WILL 
BE  SUMMED  AT  EACH  FREQUENCY  FOR  REAL  AND 
IMAGINARY  PART. 


COMMON/BLK1 /FREQ. AMASS .OMEGA 

COMMON  /BLK2/M.N.G.ALAM.CMU.K.NF , NPL ATE » NBEAMS 
DIMENSION  AMAT( 90.90) .BMAT ( 90  *  90 ) . B ( 16 ) . I PARAM  (  2 ) 
DIMENSION  FREQ (25 ) .AMASS! 25 ) .OMEGA ( 100) 

REWIND  ITP1 
REWIND  ITP2 
REWIND  I TP3 

I  PAR  AM ( 1 )  =  NPLATE  +  2*NBEAMS 

I  PAR AM ( 2 )  ■  2*NF 

NAME  =  0 

NM AT  =  0 

NFILE  •  0 

CALL  WRTETP ( I P ARAM . 1 . NAME . 1 . 2 . B »NF I LE .NMAT . I TP3 » I RR ) 
IF  (  IRR  »NE.  0  )  GO  TO  9986 
NAME  =  0 
NFILE  -  0 
C 

DO  500  II  =  l.NF 
WRITE(6.9000)  OMEGA (  I  I  ) 

IF  (  II  *EQ«  1  )  GO  TO  10 
NMAT  =  0 
GO  TO  20 
10  NMAT  =  1 

20  CALL  READTP(AMAT. 90. NAME. N.N.B. NFILE. NMAT. ITP1. IRR) 

CALL  READTP(BMAT.90.NAME»N.N»B.NFILE.NMAT.ITP2.IRR) 
IF  (  IRR  .NE.  0  )  GO  TO  9985 
DO  50  I  =  l.N 
DO  50  J  «  l.N 

50  AMAT(I.J)  -  AMAT(I.J)  +  BMAT(I.J) 

DO  450  I  -  l.N 

WRITE (6.9001 ) I . ( AMAT ( I »J) »J*1.N) 

450  CONTINUE 
C 

NMAT  =  0 

CALL  WRTETP(AMAT.90»NAME.N»N,B.NFILE.NMAT,ITP3.IRR) 
IF  (  IRR  .NE.  0  )  GO  TO  9986 
500  CONTINUE 
C 
C 

DO  600  I  I  ■  l.NF 

WR I T  E ( 6 • 9002 )  OMEGA(II) 

NAME  =  0 
NMAT  =  0 
NFILE  «  0 

CALL  READTP  ( AM AT • 90 . NAME .N .N . B »NF I LE • NMAT • I TP2 . I RR ) 
IF  (  IRR  .NE.  0  )  GO  TO  9985 
NAME  *  0 
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nmat  =  0 


NFILE  =  0 

CALL  WRTETP ( AM AT  #90  .NAME  *N  *N * B  »NF I LE  #NMAT  .ITP3.IRR) 
IF  (  IRR  .NE.  0  )  GO  TO  9966 
DO  550  I  -  1  *N 

WRITE (6* 9001) I . ( AMAT ( I *J) *J»1*N) 

550  CONTINUE 
600  CONTINUE 
C 

END  FILE  ITP3 
RETURN 

9985  WRITEI6.9990)  IRR 
CALL  EXIT 

9986  WR I TE ( 6  # 9991 )  IRR 
CALL  EXIT 
RETURN 


9000  FORMAT (1HO»33HDEFLECTION  CO-POWER.  FREQUENCY  -  E14.7.11H 
1)  //) 

9001  FORMAT (1H0.I5.1P7E16.6/(E22.6»6E16#6)  ) 

9002  FORMAT  < 1HO * 35HDEFLECT ION  QUAD-POWER.  FREQUENCY  ■  E14.7.UH 
1EC)  //) 

9990  FORMAT ( 28H  ERROR  IN  READTP-ERROR  CODE-15) 

9991  FORMAT ( 28H  ERROR  IN  WRTETP-ERROR  CODE-15) 

END 


(RAD/SEC 

(RAD/S 
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SUBROUTINE  PRINTE 


SlBFTC  PRNTE«  DECK 

SUBROUTINE  PRINTE 
C 
C 

C  THE  STRESS-PSD  MATRICES  ARE  PRINTED  FOR 

C  OPTION  2  IN  THIS  SUBROUTINE. 

C 

C 

C 

COMMON/BLK1 /FREQ. AMASS .OMEGA 

COMMON/6LK2/M.N.G.ALAM.CMU.K.NF. NPLATE. NBEAMS 
COMMON / BLK3/F LG 1 .FLG2.FLG3.FLG4 
INTEGER  FLG1.FLG2.FLG3.FLG4 

DIMENSION  FREQ ( 25 ) .AMASS (25 ) .OMEGA ( 100 ) »S ( 8 » 8 ) . B ( 16 ) .SB ( 6 .6 ) 
NTAPE  =  15 
REWIND  NTAPE 
NAME  =  0 
NMAT  =  0 
NFILE  *  0 
C 

C***IF  NPLATE  EQUALS  0  -  SKIP  PLATES  PRINTOUT 
IF  (  NPLATE  .EQ.  0  )  GO  TO  200 
C 
C 
C 

DO  100  III  «  1 .NPLATE 
WRITEI6.9000) 

C 

DO  60  II  =  1.2 

IF  (  II  .EQ.  2  )  GO  TO  10 

WR I T  E ( 6 . 9001 ) 

GO  TO  20 

10  WR I TE ( 6  » 9002 ) 

C 

20  DO  50  IJ  =  l.NF 

WR I TE ( 6 . 9003 )  OMEGA(IJ) 

CALL  READTP(S.e.NAME.NR.NC.B.NFILE.NMAT.NTAPE.IRR) 

IF  (  IRR  .NE.  0  I  GO  TO  9985 
DO  15  I  »  1.8 

WRITE (6. 9004) I . ( S ( I t J ) . J- 1 • 8 ) 


15 

CONTINUE 

50 

CONTINUE 

60 

CONTINUE 

100 

CONTINUE 

C 

C 

C 

C 

C*»*IF  NBEAMS  EQUALS  0  -  SKIP  BEAMS  PRINTOUT 
200  IF  (  NBEAMS  .EQ.  0  )  RETURN 
C 
C 

DO  1000  III  -  1. NBEAMS 
WRITE(6. 9005)11  I 
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c 

c 

70 

80 

C 

90 

C 

995 

C 

998 

C 

C 

999 

C 

C 

1000 

c 

c 

c 

c 

9985 

9000 

9001 

9002 

9003 

9004 

9005 

9006 

9007 

9008 

9009 

9010 

9990 


DO 

999  11=1 

•  2 

WRI 

TE ( 6  *  9006 ) 

I  I 

DO 

998  IJ  =  1 

*2 

IF 

(  IJ  .EQ. 

2  )  GO  TO 

WRI 

TE ( 6  *  9007 ) 

GO 

TO  80 

WRI 

TE ( 6  *  9008 ) 

DO 

995  11  =  1 

*NF 

WRI 

T  E ( 6  *  9009 ) 

OMEGA  (ID 

CALL  READTP(SB*6*NAME*NR*NC*B*NFILE*NMAT»NTAPE*IRR) 
IF  (  IRR  .NE.  0  )  GO  TO  9985 

DO  90  I  =  1*6 

WRITE (6*9010) I  *  <  SB  < I *J) *J=1*6) 

CONTINUE 

CONTINUE 

CONTINUE 


CONTINUE 


CONTINUE 


REWIND  NT APE 
RETURN 

WR I TE ( 6  *  9990 )  IRR 
CALL  EXIT 
RETURN 

FORMAT ( 1H0#6HPLATE  13) 

FORMAT (10X#9HREAL  PART///) 

FORMAT ( 10X»9HIMAG  PART///) 

FORMAT (20X»10HFREQUENCYaE14.7) 

FORMAT < 1H0 * 14X # 15 *8E 14.5/ (20X*8E14. 5 )  ) 

FORMAT ( 1H0*6H  BEAM  13///) 

FORMAT ( 10X»4HEND  13//) 

FORMAT (1H0#17X»10HREAL  PART  15//) 
F0RMAT(1H0*17X#10HIMAG  PART  15//) 

FORMAT (1H0»30X»10HFREQUENCY=E14. 7///) 
FORMAT < 1H0*30X* 15 *6E14.5/ (36X.6E14.5  )  ) 

F0RMATI28H  ERROR  IN  READTP-ERROR  C0DE=I5> 
END 
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SUBROUTINE  DSECM3 


SIBFTC  DSECM*  DECK 

SUBROUTINE  DSECM3 

THE  DEFLECTION  SECOND  SPECTRAL  MOMENTS  ARE 
FORMED  FOR  OPTION  3. 

THE  DEFLECTION  CO-VARIANCE  MATRICES  ARE  MULTIPLIED 
BY  FREQ**2  AND  SUMMED  OVER  M  NORMAL  MODES. 

COMMON /BLK1/ FREQ 

COMMON/BLK2/M*N»G#ALAM*CMU.K»NF*NPLATE.NBEAMS 

DIMENSION  AMAT (90*90  ) » B ( 16 ) » SUM < 90  *  90 ) . FREQ ( 2 5 > » I  PAR AM < 2  ) 

NTAPE  =  8 
REWIND  NTAPE 
DO  10  I  =  1  *  N 
DO  10  J  =  1 »N 
10  SUM (  I  * J)  =  0. 

NAME  =  0 
NMAT  =  0 
NFILE  =  0 
DO  100  II  =  1 »M 

CALL  READTPIAMAT  *90*NAME*N»N»B*NFILE  .NMAT. NTAPE. IRR) 

IF  (  IRR  .NE.  0  )  GO  TO  9983 
DO  50  I  =  1 ♦ N 
DO  50  J  =  1  * N 

50  SUM ( I  *  J )  =  SUM ( I » J )  +  AMAT  ( I * J ) *FREQ ( II )**2 

100  CONTINUE 
NTAPE  =  3 
REWIND  NTAPE 
NO  =  1 
NAME  =  0 
NMAT  =  0 
NFILE  =  0 

c***form  parameter  matrix  iparam 

I  PAR AM ( 1 )  =  NPLATE  +  2*NBEAMS 
IPARAM ( 2 )  =  NO 

CALL  WRTETP ( I P ARAM  *  1 . NAME  *  1 . 2  * B . NF I LE . NM AT . N T AP E . IRR) 

IF  (  IRR  .NE.  0  )  GO  'TO  9986 
NAME  =  0 
NMAT  =  0 
NFILE  =  0 

CALL  WRTETP(SUM*90*NAME*N»N»B*NFILE*NMAT  *NTAPE» IRR) 

IF  (  IRR  .NE.  0  )  GO  TO  9986 
WR I TE ( 6  *  9000 ) 

DO  200  I  =  l.N 

WRITE (6 *9001) I . (SUM! I ♦ J ) * J=1 *N ) 

200  CONTINUE 

END  FILE  NTAPE 
RETURN 

9985  WR I TE ( 6  *  9990 )  IRR 
CALL  EXIT 

9986  WR  I T  E ( 6  »  9991 )  IRR 
CALL  EXIT 
RETURN 

9000  FORMAT ( 1H1.30X.53HDEFLECTION  SECOND  SPECTRAL  MOMENT  MATRIX  (REAL  P 

1ART )  ///) 

9001  FORMAT (1H0»I5»1P7E16.6/(E22.6»6E16,6)  ) 

9990  FORMAT ( 28H  ERROR  IN  READTP-ERROR  CODE=I5> 

9991  FORMAT ( 28H  ERROR  IN  WRT ETP-ERROR  CODE=I5) 

END 
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LOAD  *  EXECUTE 
PARTITION  CORE 
REW  8( SCRATCH) 

REW  1KDIAG  SCALARS) 
REW  1 7  <  CFW-NXN  ) 

READ  PARAMETER  M 
READ  DIAG  SCALARS 
READ  MODE  S ( PHI ) 

READ  CFW 
PH I<  TRANSP) *CFW 
PHICTRANSP) *CFW*PHI 
READY  NEXT  SCALAR 

SCALAR  MULT 
SCALAR  MULT 
POST  MULT  BY  PHHTRI 
STORE  ON  TAPE  8 
CYCLE  M  TIMES 
WRITE  EOF  ON  8 


LOAD  +  EXECUTE 
PARTITION  CORE 
REW  3  (JD) 

REW  10  (STRESSES) 

REW  15 

READ  PAR AM<  CYCLE  CNT ) 
RE  AO  JD 

SKIP  1  EOF  ON  10 
READ  STRESSES(S) 

(S )*( JD) 

(S)*(  JD)*(S)TRANSP 
STORE  ON  TAPE  15 
CYCLE 

WRITE  EOF  ON  15 


LOAD  +  EXECUTE 
PARTITION  CORE 
REW  3  (JO) 

REW  10  (STRESSES) 

REW  15 

READ  PAR  AM1CYCLE  CNT) 
READ  JD 

SKIP  1  EOF  ON  10 
READ  STRESSES! S ) 

(S)*( JD) 

(S)*( JD)*(S)TRANSP 
STORE  ON  TAPE  15 
CYCLE 

WRITE  EOF  ON  15 


LOAD  +  EXECUTE 
PARTITION  CORE 
REW  8  (SCRATCH) 
REW  2  (SCALARS) 
REW  1 1 ( MODES ) 
REW  1 7  (  CF  W ) 
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20000000 

8000B 

OB 

READ  M.NF 

20000000 

8006B 

OB 

READ  SCALARS 

-  1 10000000 

08 

REW  1 1  ( MODES ) 

1 70010000 

08 

SKIP  EOF  ON  17 

110000000 

8034B 

00 

READ  MODES! PHI ) 

170000000 

18 

08 

READ  CFW 

8034  0 

1  0 

20 

80 

PHI(TPANSP)*CFW 

2B 

8034B 

IB 

60 

PHI(TRANSP)*CFW*PHl 

80090 

81370 

2  70 

READV  NEXT  SCALAR 

-10 110 

10 

270 

81370 

IB 

81400 

5B 

SCALAR  MULT 

81430 

80340 

20 

50 

SCALAP  MULT 

8034B 

30 

98 

PH  I  (TRANSP) 

20 

3  B 

4B 

6B 

MULT 

-  17001 OOOB 

OB 

BACKSPACE  l  EOF 

4B 

80000000 

00 

STORE  ON  TAPE  8 

— 12  B 

80030 

OB 

CYCLE  M  TIMES 

-10913 

80030 

330 

RESTORE  SCALAR  CELLS 

—  17B 

80058 

OB 

CYCLE  NFREO  TIMES 

■f 

80100 

00 

LOAD  +  EXECUTE 

82000 

08 

PARTITION  CORE 

-30000000 

08 

REW  3  (JO) 

-150000000 

OB 

REW  15 

30000000 

80000 

OB 

READ  PAR AM( CYCLE  CNT ) 

- 10000000B 

00 

REW  10  (STRESSES) 

30000000 

10 

08 

READ  JD 

1 0001000B 

08 

SKIP  l  EOF  ON  10 

100000003 

20 

OB 

READ  STPESSES(S) 

2B 

10 

3B 

60 

(S)*( JD) 

3B 

20 

48 

70 

(S)*(J0)*(S)TPANSP 

4B 

1 50000000 

08 

STORE  ON  TAPE  15 

—  4B 

8003B 

08 

CYCLE 

-8B 

8004B 

OB 

CYCLE  NFREO 

150000000 

08 

WRITE  EOF  ON  15 

+ 

8150B 

00 

LOAD  +  EXECUTE 

8350B 

OB 

PARTITION  CORE 

—  8000000B 

08 

REW  8(SCRATCH) 

- 1 1 OOOOOOB 

00 

REW  1 1 ( D I  AG  SCALARS) 

-  170000008 

08 

REW  1 7 ( CF  W— NXN ) 

110000000 

80000 

00 

READ  PARAMETER  M 

110000000 

8004B 

00 

READ  0 1  A  G  SCALARS 

110000008 

80320 

OB 

READ  MODES( PHI ) 

170000  0  OR 

10 

OB 

READ  CFW 

8032B 

10 

2B 

80 

PHI(TRANSP)*CFW 

20 

8032B 

10 

6B 

PHI (TRANSP) *CFW*PHI 

80070 

8136B 

273 

READY  NEXT  SCALAR 

— 10 1 1 B 

10 

2  70 

8136B 

IB 

81380 

50 

SCALAR  MULT 

81410 

8032B 

20 

50 

SCALAR  MULT 

2B 

8032B 

30 

70 

POST  MULT  BY  PHI ( TR ) 

3B 

80000008 

08 

STORE  ON  TAPE  8 

-100 

30038 

00 

CYCLE  M  TIMES 

80000003 

OR 

WRITE  EOF  ON  8 
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83508 

08 

LOAD  +  EXECUTE 

8750B 

OB 

PARTITION  CORE 

-8000000B 

OB 

REW  8 < SCRATCH) 

-150000008 

08 

REW  15(EXCITAT IONS ) 

-160000008 

OB 

REW  16  t  MODE  SHAPES) 

1600000  OB 

80008 

08 

READ  M-l.K.N 

160  000  OOB 

80078 

08 

READ  K  TERMS 

80048 

80068 

278 

COPY  K 

160  000  OOB 

80418 

OB 

READ  PHIC I ) 

82478 

i03e 

298 

CLEAR  103  CELLS 

82488 

18 

27B 

SET  ROW  DIM 

82498 

8005B 

27B 

SET  COL  DIM 

8006  8 

8010B 

278 

READY  NEXT  K 

-10148 

18 

2  7B 

160000  OOB 

81448 

OB 

READ  PHI ( J ) 

150000008 

IB 

08 

READ  COl I . J)  MATRIX 

80418 

18 

28 

88 

PHI  ( I )TRANSP*CQ<  I.J) 

28 

8144B 

38 

68 

MULT  BY  PHI(J) 

81448 

48 

98 

PH  I  ( J ) TRANSP 

3B 

4B 

8247B 

308 

MULT  +  ADD 

-68 

8006B 

08 

CYCLE  J= I ♦ 1 » I +K 

80418 

8247B 

18 

68 

MULT  SUM  J  BY  PHI(I) 

18 

8000000B 

08 

STORE  SUM  OF  J  ON  8 

-158 

80038 

08 

CYCLE  1=1. M-l 

- 16000000B 

08 

REW  16 

16000002B 

08 

SKIP  2  MATRICES  ON  16 

-1144B 

80038 

33B 

REDUCE  K  LOC 

-20  B 

28 

OB 

CYCLE  BACK  FOP  IMAG 

80000008 

08 

WRITE  EOF  ON  8 

80108 

08 

LOAD  +  EXECUTE 

82008 

08 

PARTITION  CORE 

-30000008 

08 

REW  3  (JD) 

-150000008 

OB 

REW  15 

30000008 

80008 

08 

READ  PARAMICYCLE  CNT ) 

-100000008 

OB 

REW  10  (STRESSES) 

30000008 

18 

OB 

READ  JD 

1 000 1000  B 

08 

SKIP  1  EDF  ON  10 

100000008 

28 

08 

READ  STRESSES(S) 

2B 

IB 

3B 

68 

(S>*( JD) 

38 

2  B 

48 

7B 

(S)*( JD)*(S)TRANSP 

4B 

1  50000008 

OB 

STORE  ON  TAPE  15 

-48 

8003B 

OB 

CYCLE 

-88 

80048 

OB 

CYCLE 

150000008 

08 

WRITE  EOF  ON  15 

815  OB 

OB 

LOAD  +  EXECUTE 

8350B 

OB 

PARTITION  CORE 

-80000008 

08 

REW  8 ( SCR  A  TCH) 

- 1 1 OOOOOOB 

08 

REW  11(01  AG  SCALARS) 

-  1 7000000B 

OB 

REW  1 7 ( CF W-NXN ) 

110000008 

80008 

08 

READ  PARAMETER  M 

110000008 

8004B 

08 

READ  DIAG  SCALARS 

1 10000  OOB 

8032B 

OB 

READ  MODES ( PHI ) 

170000008 

18 

OB 

READ  CFW 

8032B 

IB 

28 

88 

PHI(TRANSP)*CFW 

2B 

80328 

18 

68 

PHI (TRANSP) *CFW*PH1 

800  7  B 

81368 

278 

READY  NEXT  SCALAR 

475 


— 10 1 1 B 

IB 

27B 

8136B 

IB 

8138B 

5B 

814  l  B 

8032B 

2B 

5R 

2B 

8032B 

3B 

7B 

3B 

8000000B 

OB 

-10B 

8003B 

OB 

80000003 

OB 

8350B 

OB 

8750B 

OB 

- 8000000B 

OB 

- 1 5000000B 

OB 

- 16000000B 

OB 

1600000  OB 

8000B 

OB 

16000000B 

8007B 

OB 

8004B 

8006B 

2  7B 

16000000B 

804  IB 

OB 

8247B 

103B 

29B 

8248B 

IB 

27B 

8249B 

8005B 

27B 

8006  B 

8010B 

27B 

-10148 

IB 

2  7B 

160000  OOB 

8144B 

OB 

15000000B 

IB 

OB 

804  IB 

IB 

2B 

8B 

2B 

8  144B 

38 

6B 

8144B 

4B 

9B 

3B 

4B 

8247B 

30B 

— 6B 

8006B 

OB 

804  IB 

8247B 

IB 

68 

IB 

8000000B 

08 

-15B 

8003B 

OB 

- 1 6000000B 

OB 

1 6000002B 

OB 

-1144B 

8003B 

33B 

-20B 

2B 

OB 

8000000B 

OB 

801  OB 

OB 

8200B 

OB 

-3000000B 

OB 

- 15000000B 

OB 

300000  OB 

8000R 

08 

- 10000000B 

OB 

300000  OB 

IB 

OB 

10001000B 

OB 

100000008 

2B 

OR 

2B 

IB  3B 

68 

3B 

28  4B 

7B 

4B 

1 5000000B 

OB 

-4B 

8003B 

OB 

—  8B 

8004B 

OB 

1  5000000B 

OR 

8150B 


8350B 


OB 

OB 


SCALAR  MULT 
SCALAR  MULT 
POST  MULT  BY  PHKTR) 
STORE  ON  TAPE  8 
CYCLE  M  TIMES 
WRITE  EOF  ON  8 


LOAD  +  EXECUTE  * 
PARTITION  CORE 
REW  8<  SCRATCH) 

REW  15(EXCITATIONS) 
REW  1 6  < MODE  SHAPES) 
READ  M-l.K.N 
READ  K  TERMS 
COPY  K 
READ  PHI ( I) 

CLEAR  103  CELLS 
SET  ROW  DIM 
SET  COL  DIM 
READY  NEXT  K 

READ  PHI ( J ) 

READ  C0( I  *  J  )  MATRIX 
PHI ( I ) TRANSP*CO(  I .  J  ) 
MULT  BY  PHI(J) 
PHI(J)TRANSP 
MULT  +  ADD 
CYCLF  J=l+l.I+K 
MULT  SUM  J  BY  PHI ( I ) 
STORE  SUM  OF  J  ON  8 
CYCLE  1=1. M-l 
REW  16 

SKIP  2  MATRICES  ON  16 
REDUCE  K  LOC 
CYCLE  BACK  FOR  IMAG 
WRITE  EOF  ON  8 


LOAD  +  EXECUTE 
PARTITION  CORE 
REW  3  (JD) 

REW  15 

READ  PARAMICYCLE  CNT ) 
REW  10  (STRESSES) 

READ  JD 

SKIP  1  EOF  ON  10 
READ  STRESSFS(S) 

<S)*( JD) 

(S)*< JD)*(S)TRANSP 
STORE  ON  TAPE  15 
CYCLE 

CYCLE  NF  TIMES 
WRITE  EOF  ON  15 


LOAD  +  EXECUTE 
PARTITION  CORE 
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- 8000000B 

OB 

PEW  8  (SCRATCH) 

- 2000000B 

OB 

REW  2  (SCALARS) 

—  1 1 OOOOOOB 

OB 

REW  1 1  ( MODE  S ) 

-  1 7000000B 

OB 

REW  17(CFW) 

200000  OB 

80008 

OB 

READ  M.NF 

2000000B 

8006B 

OB 

READ  SCALARS 

- 1 1000000B 

OB 

REW  1 1 ( MODE  S ) 

l 7001 000 B 

OB 

SKIP  EOF  ON  17 

110  000  OOB 

80348 

OB 

READ  MODE  S( PHI ) 

1700000CB 

IB 

OB 

READ  CFW 

8034  B 

IB  2B 

8B 

PHI  (TRANSP) *CFW 

2B 

8034B  IB 

68 

PHI ( TRANSP) *CFW*PHI 

8009B 

8137B 

2  78 

READY  NEXT  SCALAR 

-10118 

IB 

27B 

8137B 

IB  8140B 

5B 

SCALAR  MULT 

8 143  B 

8034B  2B 

5B 

SCALAR  MULT 

8034B 

3B 

9B 

PHI ( TRANS  P) 

26 

3  B  4B 

6B 

MULT 

- 17001000B 

OB 

BACKSPACE  1  EOF 

4B 

8000000B 

OB 

STORE  ON  TAPE  8 

- 12  B 

8003B 

OB 

CYCLE  M  TIMES 

-1091B 

8003B 

33B 

RESTORE  SCALAR  CELLS 

-17B 

8005B 

OB 

CYCLE  NFREO  TIMES 

8350B 

OB 

LOAD  AND  EXECUTE 

8750B 

OB 

PARTITION  CORE 

-  8000000  B 

OB 

REW  8 ( SCR  ATCH ) 

- 1  5000000B 

OB 

REW  15(EXCITAT IONS) 

- 1 6000000B 

OB 

REW  16( MODE  SHAPES) 

160  000  OOB 

aoooB 

OB 

READ  M— 1 1K1N1 NFREO 

16000000B 

80088 

OB 

READ  K  OFF-DIAG  TERMS 

800  4  B 

8007B 

273 

COPY  K 

160000  OOR 

8035B 

OB 

RF AD  PHI (  I  ) 

824  IB 

103B 

29B 

CLEAR  103  CELLS 

8242B 

IB 

27B 

ADD  ROW  DIM 

82436 

8005B 

27B 

ADD  COL  DIM 

800  7  B 

801  IB 

276 

READY  NEXT  K 

-1014B 

IB 

27B 

160  000  OOB 

813  88 

OB 

RE  AO  PH  I ( J ) 

1500000CR 

IB 

OB 

READ  C( I . J)  MATRIX 

8035B 

IB 

23 

88 

PHI ( I )TRANSP*CO( I.J) 

2B 

8138B 

3B 

6B 

MULT  BY  PHI ( J ) 

8138B 

4B 

93 

PHI  ( J)TRANSP 

3B 

4B 

8  24  1 B 

30B 

MULT  +  ADD 

— 6B 

8007B 

OB 

CYCLE  J=I  +  l.I«-K 

8035B 

82413 

IB 

6B 

MULT  BY  PHI ( I ) 

IB 

8000000B 

OB 

STORE  SUM  OF  J  ON  8 

-15B 

8003B 

OB 

CYCLE  I  =  l.M-1 

- 16000000B 

OB 

REW  16 

1 6000002B 

03 

SKIP  2  MATRICES  ON  16 

-11448 

8003B 

3  3B 

RESET  K  LOC 

-20  B 

8006B 

OB 

CYCLE  NF  TIMES 

-21  B 

2B 

03 

CYCLE  REAL  *  IMAG 

8000000B 

03 

WRITE  EOF  ON  8 

801  OB 

03 

LOAD  +  EXECUTE 

82003 

OB 

PARTITION  CORE 

-80000008 

OB 

REW  8  (PARAM-CPSD) 
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-100000008 

OB 

-150000008 

08 

8000000B 

80008 

OB 

—  8  OOOOOOB 

OB 

10001000B 

08 

100000008 

IB 

08 

800000  IB 

08 

80000008 

2B 

08 

18 

2  B 

3B 

68 

3B 

IB 

48 

7B 

4B 

150000008 

08 

-48 

8004B 

OB 

- 8000000B 

OB 

— 8B 

8003B 

OB 

1 5000000B 

08 

80108 

OB 

-  12000000B 

OB 

-140000008 

08 

—  1 5000000B 

OB 

-  160000008 

OB 

120000008 

OB 

8200B 

OB 

140000  OOB 

8000B 

OB 

1 50000  OCR 

18 

08 

IB 

18 

18B 

160000  OOB 

28 

OB 

18 

2  B 

38 

68 

2B 

3  B 

18 

68 

1  5000000B 

28 

08 

2B 

IB 

28 

18 

38 

18 

08 

28 

28 

18B 

IB 

2B 

38 

6B 

2B 

120000008 

08 

38 

120000008 

06 

1 2  OOOOOOB 

08 

-13  P 

8005B 

08 

801  OB 

08 

85008 

08 

-30000008 

OB 

-120000008 

OB 

-140000008 

08 

-  1 5000000B 

08 

- 16000000B 

OB 

-  170000008 

08 

14000000B 

80008 

08 

1 2001000B 

08 

170010008 

08 

120000008 

IB 

08 

170000008 

2B 

08 

2B 

IB  3B 

68 

3B 

18 

08 

17000000B 

28 

OB 

120000006 

38 

06 

28 

38  IB 

30! 

REW  10  ( STRESSES  ) 
REW  15 
RE  AO  PARAM 
REW  8 

SKIP  1  EOF  on  10 
READ  STRESS 
SKIP  1  MATRIX 
RE  AO  CPSO 
S*CPSD 

S*CPSD*S  TRANP 
STORE  ON  TAPE  15 
CYCLE  REAL*  IMAG 
REW  8 

CYCLE  STRESSES 
WRITE  EOF  ON  15 


LOAD  +  EXECUTE 
REW  12  (OUTPUT) 

REW  14  (PARAM) 

REW  15  (A-REAL  ) 
REW  16  (  R- 1  MAG  ) 
WRITE  EOF  ON  12 
PARTITION  CORE 
READ  PARAM 
RE  AO  A 
A( INVERSE ) 

READ  B 
A ( I NV ) *B 
B*A( INV)*B 
READ  A 

A+R*A( I NV  J  * 8 
COPY  A( INV) *8 
(A+B*A(INV)*B)  INV 
MULT  -  IMAG 
SAVE  J  -  REAL 
SAVE  L  -  IMAG 
WRITE  EOF  ON  12 
CYCLE  NF  TIMES 


LO AO  +  EXECUTE 
PARTITION  CORE 
REW  3  -SCRATCH 
REW  12  (L  AND  J) 

REW  14  (  PARAM  ) 

REW  15  (OUT-REAL) 

REW  16  (  OUT-  I  MAG ) 

REW  17— OF  AND  CF  MAT. 

READ  PARAM 

SKIP  1  EOF 

SKIP  PAST  1  EOF 

READ  L  MATRIX 

READ  OF  MATRIX 

MULT  QF*L 

COPY 

READ  CF  MATRIX 
READ  J  MATRIX 
CF*  J  ♦  OF  *L  =  X 
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3B 

IB 

2B 

6B 

J*X 

2B 

3000000B 

OB 

STORE  ON  TAPE  3 

- 12001000B 

OB 

BACKSPACE  1  EOF 

12000000B 

2B 

OB 

READ  L  MATRIX 

2B 

IB 

3B 

6B 

MULT  L*X  MATRIX 

3B 

3000000B 

OB 

STORE  ON  TAPE  3 

3  OOOOOOB 

OB 

WRITE  EOF  ON  3 

12000000B 

IB 

OB 

READ  J  MATRIX 

— 1700 1000B 

OB 

BACKSPACE  PAST  1  EOF 

170000008 

2B 

OB 

READ  OF  MATRIX 

2B 

IB 

38 

6B 

MULT  OF* J 

3B 

IB 

OB 

COPY 

IB 

IB 

2B 

IB 

ADD  QF*J  ♦  QF*J=Y 

IB 

2  B 

IB 

28 

SUBT  QF*J  -  Y  =  -QF* J 

17000000B 

2B 

OB 

READ  CF  MATRIX 

- 12001000B 

OB 

BACKSPACE  1  EOF 

12000000B 

38 

OB 

READ  L  MATRIX 

2B 

3  B 

IB 

30B 

CF*L  -  QF*J  =  Z 

3B 

IB 

2B 

6B 

MULT  L*Z 

-3000000B 

OB 

REW  3 

3000000B 

3B 

OB 

READ  REAL 

2B 

3B 

2B 

IB 

TOTAL  REAL 

2B 

150000008 

OB 

STORE  REAL 

120000008 

2B 

08 

READ  J  MATRIX 

2B 

IB 

3B 

6B 

MULT  J*Z 

3000000B 

IB 

OB 

READ  IMAG 

IB 

3  B 

IB 

2B 

IMAG 

IB 

16000000B 

OB 

STORE  IMAG 

— 37B 

8005B 

OB 

CYCLE  NF  TIMES 

1 5000000B 

OB 

WRITE  EOF  ON  15 

16000000B 

OB 

WRITE  EOF  ON  16 

+ 

801  OB 

OB 

LOAD  +  EXECUTE 

8  200B 

OB 

PARTITION  CORE 

-3000000B 

OB 

REW  3 

- 10000000B 

OB 

REW  10  (STRESSES) 

— 14000000B 

OB 

REW  14  (PARAM) 

- 15000000B 

08 

REW  15  ( REAL— CPSD) 

— 16000000B 

OB 

REW  16  ( I  MAG— CPSD) 

14000000B 

8000B 

OB 

READ  PARAM 

l 0001000B 

OB 

SKIP  1  EOF  ON  10 

10000000B 

IB 

08 

READ  STRESS 

15000000B 

2B 

OB 

READ  REAL  CPSD 

IB 

2B 

3B 

6B 

S*CPSD— REAL 

3B 

IB 

4B 

7B 

S*CPSD*S  TRANP 

4B 

3000000B 

OB 

STORE  ON  TAPE  3 

16000000B 

2B 

OB 

READ  IMAG  CPSD 

IB 

2B 

3B 

6B 

S*CPSD  IMAG 

3B 

18 

4B 

7B 

S*CPSD*S  TRANP 

4B 

3000000B 

OB 

STORE  ON  TAPE  3 

-8B 

8005B 

OB 

CYCLE  NF  TIMES 

— 15000000B 

OB 

REW  15  REAL  CPSD 

- 16000000B 

OB 

REW  16  IMAG  CPSD 

—  12  B 

8007B 

OB 

CYCLE  STRESSES 

3 OOOOOOB 

OB 

WRITE  EOF  ON  TAPE  3 

♦ 

8200B 

08 

LOAD  *  EXECUTE 
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8500B 

OB 

PARTITION  core 

-4000000B 

OB 

REW  4  (CONSTANTS) 

-  12000000B 

OB 

REW  12  (OUTPUT) 

-14000000B 

OB 

REW  14  (PARAM) 

-15000000B 

OB 

REW  15  (REAL-CPSO) 

-  16000000B 

OB 

REW  16  (IMAG-CPSD) 

140000008 

8000B 

OB 

READ  PARAM 

4000000B 

80 1  OB 

OB 

READ  CONSTANTS 

101  4  B 

8004B 

2  7B 

8500B 

29B 

NULL  MATRIX 

8501  B 

8003B 

27B 

ADD  ROW  DIM 

8502B 

8003B 

27B 

AOD  COL  DIM 

801  3  B 

8199B 

27B 

-101  IB 

IB 

27B 

READY  NEXT  SCL 

1 50000  00B 

2B 

OB 

READ  A  MATRIX 

8199B 

2  B 

2B 

5B 

A*  SCL 

2B 

IB 

IB 

IB 

SUM 

— 5B 

8005B 

OB 

CYCLE  FREQ 

IB 

12000000B 

OB 

STORE  JD 

—107 1 B 

8005B 

33B 

SET  LOC  AGAIN 

—106  1  B 

-IB 

1 OOOOOOB 

27B 

SET  TO  TAPE  16 

-13B 

2B 

OB 

CYCLE  BACK  FOR  IM 

1 2000000B 

OB 

WRITE  EOF  ON  12 

801  OB 

OB 

LOAD  +  EXECUTE 

8200B 

OB 

PARTITION  CORE 

-3000000B 

OB 

REW  3 

- 1 2000000B 

OB 

REW  1 2 ( JD ) 

- 1 4000000B 

OB 

REW  14(PARAM) 

14000000B 

80008 

OB 

READ  PARAM 

— 10000000B 

OB 

REW  10  (STRESSES) 

1200000  OB 

IB 

OB 

READ  JD 

10001000B 

OB 

SKIP  1  EOF  ON  10 

100000008 

2B 

OB 

READ  STRESS 

2B 

IB 

3B 

6B 

S*  JD 

3B 

2B 

4B 

7B 

S*JO*S  TRANP 

4B 

3000000B 

OB 

STORE  ON  TAPE  3 

— 4B 

8007B 

OB 

CYCLE 

— 8B 

2B 

OB 

CYCLE  RE  AL  » I  MAG 

3  OOOOOOB 
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